perm filename OCCULT.FAI[SAI,BGB] blob
sn#239344 filedate 1978-02-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00046 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00005 00002 TITLE OCCULT - A HIDDEN LINE ELIMINATOR - BRUCE G. BAUMGART - MAY 1974.
C00008 00003 SUBR(IIIDPY,WINDOW,GLASS) DEVICE DEPENDENT DISPLAY ROUTINE.
C00010 00004 SUBR(SHOW1,WND,POG) DISPLAY ALL EDGES IN VIEW.
C00013 00005 SUBR(SHOW4,WND,POG) SHADOW HIDDEN LINE ELIMATION.
C00016 00006 SUBN(ZCLIPF,FACE,CAMERA)
C00018 00007 SUBN(FMRK,WORLD) MARK POTENT FACES.
C00020 00008 SUBN(EMRK,WORLD) MARK POTENT EDGES FOR OCCULT.
C00023 00009 SUBN(ZCLIP,VERT1,VERTU,VERT2,CAMERA)
C00026 00010 SUBN(XYCLIP)
C00028 00011 XY-CLIPPER continued.
C00030 00012 SUBR(CLIPER,WINDOW)
C00032 00013 XCLIP: CLIP BODY RING.
C00036 00014 VARIABLES GLOBAL TO OCCULT ROUTINES.
C00039 00015 SUBR(OCCULT,WRLD) A HIDDEN LINE ELIMINATOR.
C00042 00016 SUBN(HIDE) HIDE A SORT-WINDOW.
C00044 00017 SUBN(MKTJ,FOLD0,EDGE0) MAKE A T-JOINT.
C00046 00018 SUBR(MKSWN,FACE,EDGE) MAKE FIRST SORT-WINDOW.
C00051 00019 SUBR(POPSWN) SORT WINDOW KILL.
C00056 00020 EDGE SORT.
C00060 00021 SUBN(PENSUR,WND) MAKE PEN & SUR FACE LISTS.
C00063 00022 SUBN(VSOLVE) SOLVE CONCAVE VERTICES.
C00067 00023 SUBN(EHIDE,FACE,EDGE,VERTEX) EDGE HIDE.
C00071 00024 SUBN(VHIDE,FACE,VERTEX) VERTEX HIDE.
C00074 00025 SUBN(COMPEE,EDG1,EDG2) COMPARE EDGE-EDGE.
C00077 00026 COMPARE E1 AND U1.
C00080 00027 SUBN(FUDGE,VERTEX,EDGE)
C00082 00028 SUBN(EBREAK,EDGE) EBREAK(EDGE) IS LIKE ESPLIT.
C00085 00029 SUBR(BLED,VNEW) BEAD LIST EDIT.
C00089 00030 SUBN(SHOW) PROPAGATE VISIBLE EDGES AND VERTICES.
C00092 00031 SUBN(VSHOW,VERTEX) MARK VISIBLE EDGES & VERTICES.
C00094 00032 SUBN(TJPROP,J) PROPAGATE UNDERFACES FROM TJOINTS.
C00096 00033 SUBN(EPROP,UF,EDGE,VERTEX) PROPAGATE UNDER FACE ALONG FOLDS.
C00099 00034 SUBN(FSCAN,VERTEX) FACE SCAN FOR UNDERFACE.
C00101 00035 SUBR(SWNDPY)
C00104 00036 SUBR(EDGDPY,EDGE)
C00106 00037 SUBR(KLJOTS,WORLD)
C00109 00038 SUBR(VERIFY) DIAGONOSTIC DISPLAY.
C00112 00039 FDPY:
C00114 00040 SUBR(SHADOW,WRLD)
C00116 00041 FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
C00119 00042 SUBR(CREIMG) CRE IMAGE: MAKE PERCIEVED IMAGES FROM CRE.
C00123 00043 SUBR(OCCIMG) MAKE OCCULT IMAGE FROM OCCULT RESULTS.
C00126 00044
C00128 00045 SUBR(MKCONE,BODY,Z1,Z2)
C00131 00046 SUBR(SHINE,WRLD) SHINE THE SUN AT ALL THE FACES OF A WORLD.
C00134 ENDMK
C⊗;
TITLE OCCULT - A HIDDEN LINE ELIMINATOR - BRUCE G. BAUMGART - MAY 1974.
;------------------------------------------------------------------------------
.INSERT MN
EXTERN QEV,QFEV,CROSSING,ZDEPTH,ZDALT,WITHIN,WITH2D
EXTERN ECW,ECCW,OTHER,BGET,FCW,FCCW,VCW,VCCW
EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
;TITLE VIEWER - IMAGE FORMING SUBROUTINES - JULY 1972.
EXTERN OTHER,VCW,VCCW,ECCW
EXTERN UNIVERSE,DPYFLG,PLTFLG
;VARIABLES GLOBAL TO VIEWER SUBROUTINES.
DECLARE{XL,XH,YL,YH}
DECLARE{SOX,SOY,MAG}
DECLARE{CAMERA,WINDOW,GLASS}
DECLARE{ALLSHARP}
SUBR(GEODPY) ;GEOMED'S DISPLAY REFRESH
COMMENT .-----------------------------------------------------------.
MOVEI 1↔DAC GLASS
LAC 1,UNIVERSE
CW 1,1↔DAC 1,W0 ;FIRST WINDOW OF DISPLAY RING.
L1: DAC 1,W
PUSH P,1 ;WINDOW.
PUSH P,GLASS ;GLASS.
LAC 1,DPYFLG
SETZM DMODE↑↔CAIN 1,3↔SETOM DMODE ;OCCULT DIAGONOSTICS.
PUSHJ P,@[SHOW2↔SHOW3↔SHOW1↔SHOW2](1)
AOS 1,GLASS↔CAML 1,MAXGLASS↔DAC 1,MAXGLASS
L2: LAC 1,W↔SIS 1,1 ;NEXT WINDOW OF THE NOW DISPLAY RING.
CAME 1,W0↔GO L1
SETZB 0,1↔LAC 2,GLASS
L3: CAML 2,MAXGLASS↔POP0J ;CLEAR HIGHER PIECES OF GLASS.
DPB 2,[POINT 4,.+1,12]
UPGIOT↔AOJA 2,L3
DECLARE{W,W0,MAXGLASS,GLASS}
ENDR GEODPY;7/12/73(BGB)---------------------------------------------
SUBR(IIIDPY,WINDOW,GLASS) ;DEVICE DEPENDENT DISPLAY ROUTINE.
COMMENT .-----------------------------------------------------------.
E←←16 ;KEEP E OUT OF III AC'S.
LAC GLASS↔CAILE 1↔GO .+3
CALL(DPYSET↑,DPYBUF↑) ;NEW POG.
;DISPLAY WINDOW FRAME.
LAC 1,WINDOW
HLRE 1(1)↔DAC XL ;PICK UP 2D CLIPPER WINDOW.
HRRE 1(1)↔DAC XH
HLRE 2(1)↔DAC YL
HRRE 2(1)↔DAC YH
TESTZ 1,DARKEN↔GO L0
CALL(AIVECT,XL,YL) ;MAKE A BOARDER.
CALL(AVECT,XH,YL)
CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)
CALL(AVECT,XL,YL)
;DISPLAY THE VISIBLE EDGE LIST.
L0: LAC E,WINDOW
NCAMR E,E↔PWRLD E,E↔JUMPE E,L3 ;GET THE WORLD.
PED E,E↔SKIPA ;1ST EDGE OF WORLD.
L1: ALT2 E,E↔JUMPE E,L3 ;CDR EDGE LIST.
X1DC 1,E↔Y1DC 2,E↔CALL(AIVECT↑,1,2)
X2DC 1,E↔Y2DC 2,E↔CALL(AVECT↑,1,2)
GO L1
L3: CALL(DPYOUT↑,GLASS)
POP2J
BEND IIIDPY;2/5/73(BGB)-------------------------------------------
SUBR(SHOW1,WND,POG) ;DISPLAY ALL EDGES IN VIEW.
COMMENT .-----------------------------------------------------------.
;ZERO WINDOW ARGUMENT PICKS UP THE DEFAULT WINDOW.
SKIPN 2,UNIVERSE↔POP2J↔SETOM ALLSHARP
SKIPN 1,WND↔CW 1,2↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ↑,CAMERA,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)↔POP2J
ENDR SHOW1;3/16/73(BGB)----------------------------------------------
SUBR(SHOW2,WND,POG) ;VECTOR HIDDEN LINE IMAGE.
COMMENT .-----------------------------------------------------------.
;ZERO WINDOW ARGUMENT PICKS UP THE DEFAULT WINDOW.
;ON NEGATIVE POG, DO NOT KILL TMPS.
SKIPN 2,UNIVERSE↔POP2J↔SETZM ALLSHARP
SKIPN 1,WND↔CW 1,2↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
TESTZ 1,DARKEN↔POP2J
CALL(PPROJ↑,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT,WORLD)
CALL(KLJOTS,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
SKIPGE POG↔POP2J
CALL(KLTMPS,WORLD)↔POP2J
ENDR SHOW2;3/16/73(BGB)----------------------------------------------
SUBR(SHOW3,WND,POG) ;DISPLAY BACKSIDED FACES REMOVED.
COMMENT .-----------------------------------------------------------.
;ZERO WINDOW ARGUMENT PICKS UP THE DEFAULT WINDOW.
SKIPN 2,UNIVERSE↔POP2J↔SETZM ALLSHARP
SKIPN 1,WND↔CW 1,2↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
CALL(PPROJ↑,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
CALL(KLTMPS,WORLD)↔POP2J
ENDR SHOW3;3/16/73(BGB)----------------------------------------------
SUBR(SHOW4,WND,POG) ;SHADOW HIDDEN LINE ELIMATION.
COMMENT .-----------------------------------------------------------.
;ZERO WINDOW ARGUMENT PICKS UP THE DEFAULT WINDOW.
;ON NEGATIVE POG, DO NOT KILL TMPS.
SKIPN 2,UNIVERSE↔POP2J↔SETZM ALLSHARP
SKIPN 1,WND↔CW 1,2↔DAC 1,WINDOW
NCAMR 1,1↔DAC 1,CAMERA↔JUMPE 1,POP2J.
PWRLD 1,1↔DAC 1,WORLD ↔JUMPE 1,POP2J.
ALT 1,1↔DAC 1,SUN#↔JUMPE 1,POP2J.
CALL(PPROJ↑,SUN,WORLD) ;SUN SHINE PASS.
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT,WORLD)
CALL(SHADOW,WORLD)
CALL(PPROJ,CAMERA,WORLD) ;CAMERA PASS.
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT,WORLD)
CALL(KLJOTS,WORLD)
CALL(CLIPER,WINDOW)
CALL(IIIDPY,WINDOW,POG)
SKIPGE POG↔POP2J
CALL(KLTMPS,WORLD)↔POP2J
ENDR SHOW4;3/11/74(BGB)----------------------------------------------
SUBR(TAKE1,CAMERA) ;SIMULATED PICTURE TAKE.
COMMENT .-----------------------------------------------------------.
LAC 2,UNIVERSE↔PWRLD 2,2
SKIPN 1,CAMERA↔NCAMR 1,2 ;CAMERA ARGUMENT OR NOW CAMERA.
DAC 1,CAMERA↔PWRLD 1,1↔DAC 1,WORLD
CALL(PPROJ,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT,WORLD)
CALL(OCCIMG)
CALL(KLJOTS,WORLD)
CALL(KLTMPS,WORLD)
POP1J ;MAKE AN OCCULT IMAGE.
ENDR TAKE1;3/11/74(BGB)----------------------------------------------
SUBR(TAKE2,CAMERA) ;SIMULATED PICTURE TAKE.
COMMENT .-----------------------------------------------------------.
LAC 2,UNIVERSE↔PWRLD 2,2
SKIPN 1,CAMERA↔NCAMR 1,2 ;CAMERA ARGUMENT OR NOW CAMERA.
DAC 1,CAMERA↔PWRLD 1,1↔DAC 1,WORLD
CALL(SHINE,WORLD)
CALL(PPROJ,CAMERA,WORLD)
CALL(FMRK,WORLD)
CALL(EMRK,WORLD)
CALL(OCCULT,WORLD)
POP1J
ENDR TAKE2;3/11/74(BGB)----------------------------------------------
SUBN(ZCLIPF,FACE,CAMERA)
COMMENT .-----------------------------------------------------------.
;GET A PZZ VERTEX OF F0 - PZZ ≡ BEHIND THE CAMERA.
L0: LAC 1,FACE
DAC 1,F0↔DAC 1,U1↔DAC 1,F
PED 0,1↔DAC E
L1: SETQ(E,{ECCW,E,F})
SETQ(V,{VCCW,E,F})
TEST 1,PZZ↔GO L1
;GET FIRST NZZ VERTEX CCW AROUND F FROM E - NZZ ≡ INVIEW.
L2: SETQ(E,{ECCW,E,F})
SETQ(V,{VCCW,E,F})
TEST 1,NZZ↔GO L2
;MAKE Z-CLIP VERTEX.
LAC 1,E↔PVT 0,1↔CAMN 0,V↔GO .+3↔CALL(INVERT,E)
PVT 0,1↔DAC V1
NVT 0,1↔DAC V2
SETQ(U2,{ESPLIT↑,E})
LAC 1,U2↔MARK 1,TMPBIT
CALL(ZCLIP,V1,U2,V2,CAMERA)
CALL(UNPROJECT,U2,CAMERA)
LAC 1,U2↔MARK 1,NZZ
;MAKE Z-CLIP EDGE.
L3: LAC 1,U1↔TEST 1,VBIT↔GO L4 ;U1 IS FACE ON 1ST TIME THRU.
SETQ(ENEW,{MKFE↑,U1,F,U2})
LAC 2,ENEW↔MARK 2,TMPBIT ;NEW EDGE IS TEMPORARY.
NFACE 1,2↔MARK 1,PZZ ;NEW FACE IS BEHIND THE CAMERA.
EXCH 1,F↔MARKZ 1,PZZ↔MARK 1,NZZ ;OLD FACE IS INVIEW.
CAMN 1,F0↔POP2J↔GO .+3 ; ...EXIT OR PASS OVER.
L4: LAC U2↔DAC U0
;ADVANCE INTO THE NEXT FACE.
LAC U2↔DAC U1
SETQ(F,{OTHER,E,F})
CAME 1,F0↔GO L2
LAC U0↔DAC U2↔GO L3
DECLARE{F,E,V,V1,V2,U0,U1,U2,ENEW,F0}
ENDR ZCLIPF;1/14/73(BGB)---------------------------------------------
SUBN(FMRK,WORLD) ;MARK POTENT FACES.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{W,B,F,Q,R}
;INITIALIZE THE WORLD'S POTENTIALLY VISIBLE FACE AND EDGE LISTS.
LAC 1,WORLD↔SETZ
PFACE. 0,1↔PED. 0,1↔NED. 0,1
NCAMR 1,1↔DAC 1,CAMERA#
;FOR ALL THE BODIES OF THE WORLD.
LAC B,WORLD↔DAC B,BODY#
L1: LAC B,BODY↔CCW B,B↔DAC B,BODY
CAMN B,WORLD↔POP1J
PED 1,B↔TEST 1,EBIT↔POP1J ;DON'T LOOK AT SINGLE POINTS
;FOR ALL THE FACES OF EACH BODY.
LAC F,B
L2: PFACE F,F↔DAC F,FACE#
CAMN F,BODY↔GO L1
MARKZ F,VISIBLE+POTENT ;HIDE.
TEST F,NZZ↔GO L2 ;FACE IS FULLY BEHIND THE CAMERA.
TEST F,PZZ↔GO L3 ;FACE IS PARTIALLY IN VIEW.
CALL(ZCLIPF,F,CAMERA) ;DO Z-CLIPPING.
LAC F,FACE
L3: PUSH P,F↔MOVNS(P)↔CALL(FACOEF) ;-F FOR PP COORDINATES.
LAC F,FACE↔SETZ↔ALT. 0,F
LAC CC(F)↔FSC =17 ; TIMES 2↑17 = 131,072.
CAML KK(F)↔GO L2 ;FACE HAS BACKSIDE TOWARDS CAMERA.
;POTENTIALLY VISIBLE FACE.
L4: MARK F,POTENT
MARKZ F,TBIT1
LAC 1,WORLD↔PFACE 0,1
POTEN. 0,F↔PFACE. F,1
GO L2
ENDR FMRK;1/14/73(BGB)-----------------------------------------------
SUBN(EMRK,WORLD) ;MARK POTENT EDGES FOR OCCULT.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{Q,R,S,B,F1,F2,E,A}
ACCUMULATORS{V1,V2}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J↔LAC E,B ;BODIES OF THE WORLD.
L2: PED E,E↔CAMN E,B↔GO L1↔SETZ↔POTEN. 0,E ;EDGES OF EACH BODY.
MARKZ E,FOLDED+VISIBLE+POTENT
PFACE F1,E↔NFACE F2,E ;FACES OF THE EDGE.
;WHEN EITHER FACE IS POTENT THEN THE EDGE IS POTENT.
LAC(F1)↔IOR(F2)
TLNN(POTENT)↔GO L2
MARK E,POTENT
;CONS THE EDGE INTO THE WORLD'S POTENTIALLY VISIBLE EDGE LIST.
LAC 1,WORLD↔PED 0,1↔SKIPN↔NED. E,1 ;INIT LAST EDGE.
PED. E,1↔POTEN. 0,E↔SETZ↔UFACE. 0,E ;CLEAR UFACE(E).
CALL(ECOEF,E)↔MARK V1,POTENT↔IORM(V2)
;WHEN ONLY ONE FACE IS POTENT THEN EDGE IS FOLDED.
LAC(F1)↔XOR(F2)↔TLNN(POTENT)↔GO L2 ;FOLDED TEST.
TEST F1,POTENT↔GO[CALL(INVERT↑,E)↔GO .+1] ;←← NOTA BENE !
MARK E,FOLDED↔IORM(V1)↔IORM(V2) ;FOLDED E,V1,V2.
SETO↔UFACE. 0,E↔GO L2 ;UNDER FACE.
ENDR EMRK;1/14/73(BGB)-----------------------------------------------
SUBR(ECOEF,EDGE) ;COMPUTE NORMALIZED EDGE COEFFICIENTS.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{V1,V2,S,B,F1,F2,E,A,FLG} ;BUT ONLY V1,V2,E,S.
LAC E,EDGE↔NVT V1,E↔PVT V2,E
LAC YPP(V2)↔FSBR YPP(V1)↔DAC AA(E)↔FMPR↔DAC 1
LAC XPP(V1)↔FSBR XPP(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
LAC XPP(V2)↔FMPR YPP(V1)
LAC S,XPP(V1)↔FMPR S,YPP(V2)↔FSBR S↔DAC CC(E)
CALL(SQRT↑,1)↔MOVSI(<1.0>)↔FDVR 0,1
FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)↔POP1J
ENDR ECOEF;7/23/73(BGB)----------------------------------------------
SUBN(ZCLIP,VERT1,VERTU,VERT2,CAMERA)
COMMENT .-----------------------------------------------------------.
F←0 ↔ U←1
ACCUMULATORS{V1,V2,X1,Y1,Z1,X2,Y2,Z2,C}
SAVAC(11)
LAC C,CAMERA
;V1 BEHIND CAMERA PLANE, V2 VEFORE CAMERA PLANE.
CDR V1,VERT1
CDR U,VERTU
CDR V2,VERT2
LAC F,3(C) ;FOCAL.
;UNPROJECT TO CAMERA CENTERED COORDINATES.
FOR @$ I←1,2{
LAC Z$I,-1(C)↔FDVR Z$I,ZPP(V$I)
LAC Y$I,Z$I↔ FMPR Y$I,YPP(V$I)↔ FDVR Y$I,-2(C)
LAC X$I,Z$I↔ FMPR X$I,XPP(V$I)↔ FDVR X$I,-3(C)}
;PIERCE Z=-FOCAL PLANE BY SIMILAR TRIANGLES & REPROJECT.
FSBR X1,X2↔ FSBR Y1,Y2↔ FSBR Z1,Z2
FADR Z2,F↔MOVNS Z2
FMPR X1,Z2↔FDVR X1,Z1↔FADR X1,X2
FMPR X1,-3(C)↔FDVR X1,F↔MOVNM X1,XPP(U)
FMPR Y1,Z2↔FDVR Y1,Z1↔FADR Y1,Y2
FMPR Y1,-2(C)↔FDVR Y1,F↔MOVNM Y1,YPP(U)
MOVM 2,-1(C)↔FDVR 2,F↔DAC 2,ZPP(U)
;....................................................................
;MARK U'S NSEW BITS.
ACCUMULATORS{XX,YY}
LAC XX,XPP(U)↔FMPR XX,MAG↔FADR XX,SOX↔XDC. XX,U↔HLLES XX
LAC YY,YPP(U)↔FMPR YY,MAG↔FADR YY,SOY↔YDC. YY,U↔HLLES YY
TYPE 0,U↔TRZ(NSEW) ;NSEW RESET.
CAMLE YY,FYH↔TRO(NORTH)
CAMGE YY,FYL↔TRO(SOUTH)
CAMLE XX,FXH↔TRO(EAST)
CAMGE XX,FXL↔TRO(WEST)
TRZ(PZZ)↔TRO(NZZ)
TYPE. 0,U
GETAC(11)↔POP4J
ENDR;1/14/73(BGB)------------------------------------------------------
SUBN(XYCLIP)
COMMENT .------------------------------------------------------------
;XY-CLIPPER, skips when portion is visible;
;expect arguments in accumulators V1 & V2;
;returns results via accumulator PTR.
ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR}
;GET NSEW BITS.
LDB 0,[POINT 4,(V1),8];
LDB 1,[POINT 4,(V2),8];
TRNE 0,(1)↔POP0J ;EASY OUTSIDER.
XDC X1,V1↔YDC Y1,V1 ;GET ENDS' LOCII.
XDC X2,V2↔YDC Y2,V2
;EASY INSIDER VERTICES.
JUMPE 0,[LAC X1↔FIXX↔DIP(PTR) ;EDGE'S DISPLAY
LAC Y1↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1] ;COORDINATES.
JUMPE 1,[LAC X2↔FIXX↔DIP(PTR)
LAC Y2↔FIXX↔DAP(PTR)↔AOBJN PTR,.+1↔GO L]
;COMPUTE EDGE COEFFICIENTS.
LAC Y1↔FSBR Y2↔DAC A
LAC X2↔FSBR X1↔DAC B
LAC X2↔FMPR Y1↔MOVNM C
LAC X1↔FMPR Y2↔FADRM C
;PARTIAL PRODUCTS.
LAC A↔FMPR FXH↔DAC AXH
LAC A↔FMPR FXL↔DAC AXL
LAC B↔FMPR FYH↔DAC BYH
LAC B↔FMPR FYL↔DAC BYL
;CORNER Q'S.
SETOM FLGO↔SETZM FLGZ
LAC AXH↔FADR BYH↔FADR C↔DAC QNE↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYH↔FADR C↔DAC QNW↔ANDM FLGO↔IORM FLGZ
LAC AXL↔FADR BYL↔FADR C↔DAC QSW↔ANDM FLGO↔IORM FLGZ
LAC AXH↔FADR BYL↔FADR C↔DAC QSE↔ANDM FLGO↔IORM FLGZ
;HARD OUTSIDER CASES.
SKIPGE FLGO↔POP0J
SKIPL FLGZ↔POP0J
;XY-CLIPPER continued.
;NORTH BORDER CROSSING.
LAC QNE↔XOR QNW↔SKIPL↔GO L2
LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG FYH↔GO L2
LAC BYH↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
LAC YH↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;SOUTH BORDER CROSSING.
L2: LAC QSE↔XOR QSW↔SKIPL↔GO L3
LAC Y1↔CAMLE Y2↔LAC Y2↔CAML FYL↔GO L3
LAC BYL↔FADR C↔MOVNS↔FDVR A↔FIXX↔DIP(PTR)
LAC YL↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;EAST BORDER CROSSING.
L3: LAC QSE↔XOR QNE↔SKIPL↔GO L4
LAC X1↔CAMGE X2↔LAC X2↔CAMG FXH↔GO L4
LAC XH↔DIP(PTR)
LAC AXH↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;WEST BORDER CROSSING.
L4: LAC QSW↔XOR QNW↔SKIPL↔GO L5
LAC X1↔CAMLE X2↔LAC X2↔CAML FXL↔GO L5
LAC XL↔DIP(PTR)
LAC AXL↔FADR C↔MOVNS↔FDVR B↔FIXX↔DAP(PTR)
AOBJN PTR,.+2↔GO L
;STRANGE EXIT - VMARK & ECOEF ARE INCONSISTENT.
L5: OUTSTR[ASCIZ/XY-CLIPPER FALL THRU !
/]↔ POP0J
;VISIBLE PORTION EXIT.
L: AOS(P)↔POP0J
DECLARE{A,B,C,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
ENDR XYCLIP;1/14/73(BGB)---------------------------------------------
DECLARE{FXL,FXH,FYL,FYH} ;FLOATING WINDOW.
SUBR(CLIPER,WINDOW)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{E,V1,V2,X1,Y1,X2,Y2,PTR,S12,B}
X←←X1 ↔ Y←←Y1 ↔ V←←V1
SETZM LINK ;SET VISIBLE EDGE LIST TO NIL.
;GET THE 2-D CLIP WINDOW FRAME.
LAC 1,WINDOW↔NCAMR 0,1↔DAC CAMERA#
HLRE 1(1)↔DAC XL↔FLOAT↔DAC FXL
HRRE 1(1)↔DAC XH↔FLOAT↔DAC FXH
HLRE 2(1)↔DAC YL↔FLOAT↔DAC FYL
HRRE 2(1)↔DAC YH↔FLOAT↔DAC FYH
;WINDOW SOURCE-OBJECT MAPPING.
LAC -1(1)↔DAC MAG
HLRE 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
HLRE 0,-2(1)↔FLOAT↔FSB 2↔DAC SOX
HRRE 2,-3(1)↔FLOAT 2,↔FMPR 2,MAG
HRRE 0,-2(1)↔FLOAT↔FSB 2↔DAC SOY
;2-D BODIES OF THE WINDOW'S CAMERA'S PREDICTED & PERCEIVED IMAGES.
LAC B,WINDOW
NCAMR B,B↔PIMAG B,B↔SKIPE B↔CALL(XCLIP) ;PERCIEVED IMAGE BODIES.
LAC B,WINDOW
NCAMR B,B↔SIMAG B,B↔SKIPE B↔CALL(XCLIP) ;PREDICTED IMAGE BODIES.
;3-D BODIES OF THE WORLD.
LAC B,WINDOW
NCAMR B,B↔PWRLD B,B↔CALL(XCLIP)
LAC 1,LINK↔PED. 1,B↔POP1J
;--------------------------------------------------------------------
XCLIP: ;CLIP BODY RING.
COMMENT .-----------------------------------------------------------.
L0: CCW B,B↔TEST B,BBIT↔GO L1
LAC V,B↔PVT V,V↔CAME V,B↔GO[
;....................................................................
;COMPUTE DISPLAY COORDINATES OF A VERTEX.
LAC X,XPP(V)↔FMPR X,MAG↔FADR X,SOX↔XDC. X,V↔HLLES X
LAC Y,YPP(V)↔FMPR Y,MAG↔FADR Y,SOY↔YDC. Y,V↔HLLES Y
;COMPARE VERTEX WITH WINDOW.
LAC 0,(V) ↔TLZ(NSEW) ;RESET NSEW TYPE BITS.
CAMLE Y,FYH↔TLO(NORTH)
CAMGE Y,FYL↔TLO(SOUTH)
CAMLE X,FXH↔TLO(EAST)
CAMGE X,FXL↔TLO(WEST)
DAC 0,(V) ↔GO .-2]↔GO L0
;....................................................................
;TEST EDGE DISPLAY CONDITIONS.
L1: CCW B,B↔TEST B,BBIT↔POPJ P,
LAC E,B
L2: PED E,E↔CAMN E,B↔GO L1 ;SCAN THE EDGES OF EACH BODY.
TESTZ E,DARKEN↔GO L2 ;DON'T DISPLAY DARKEND EDGES.
SKIPE ALLSHARP↔GO L2B ;WHEN ALLSHARP, IGNORE NSHARP.
TESTZ E,FOLDED↔GO L2A ;WHEN FOLDED, IGNORE NSHARP.
TESTZ E,NSHARP↔GO L2 ;DON'T DISPLAY NOT-SHARP EDGES.
L2A: TEST E,VISIBLE∨POTENT↔GO L2 ;MUST BE VISIBLE OR POTENT.
L2B: PVT V1,E↔NVT V2,E ;ENDS OF THE EDGE.
MOVEI PTR,U ;PSEUDO VERTEX FOR ZCLIP.
;PZZ ON WHEN VERTEX IS BEHIND THE CAMERA.
TESTZ V2,PZZ↔EXCH V1,V2 ;INSURE V2 IS INVIEW, IF EITHER BE.
TESTZ V2,PZZ↔GO L2 ;EDGE IS FULLY BEHIND THE CAMERA.
TEST V1,PZZ↔GO L3 ;EDGE IS FULLY BEFORE THE CAMERA.
;Z-CLIP IF NEEDED, XY-CLIP TO COMPUTE DISPLAY COORDINATES OF EDGE.
SETQ(V1,{ZCLIP,V1,PTR,V2,CAMERA})
L3: MOVSI PTR,-2↔HRRI PTR,-3(E) ;AOBJN PTR FOR XY-CLIP.
CALL(XYCLIP)↔GO L2 ;EDGE NOT VISIBLE IN WINDOW.
;CONS A VISIBLE EDGE INTO VISIBLE EDGE LIST.
MARK E,VISIBLE ;EDGE IS VISIBLE IN WINDOW.
LAC 1,LINK↔ALT2. 1,E
DAC E,LINK↔GO L2
;DATA.
0↔0↔0↔U: BLOCK 9 ;PSEUDO VERTEX FOR Z-CLIPPER.
LINK:0 ;HEAD OF VISIBLE EDGE LIST.
ENDR;2/5/73(BGB)-----------------------------------------------------
;VARIABLES GLOBAL TO OCCULT ROUTINES.
WORLD: 0 ;OCCULT'S ARGUMENT.
SWINDO↑:0 ;CURRENT SORTING WINDOW.
TJLIST: 0 ;TJOINT LIST.
BGND: 0 ;BACK GROUND "FACE" POINTER.
ALIST: 0 ;FREE STORAGE LIST OF 1-WORD NODES (ATOMS).
BLIST: 0 ;FREE STORAGE LIST OR 2-WORD NODES (BEADS).
GLIST: 0 ;GEM NODES IN USE IN BEADS & ATOMS.
;TJOINT LINK NAMES.
RIGHT(TJ,-1) ;TJ LIST LINK.
DEFINE TJOINT(Q,V)<CAR Q,2(V)> ;TJOINT POINTER.
DEFINE TJOIN.(Q,V)<DIP Q,2(V)>
;SORT-WINDOW NODE FORMAT.
PENCNT ←← -3 ;PENETRATING FACE COUNT.
SURCNT ←← -2 ;SURROUNDING FACE COUNT.
EDGCNT ←← -1 ;EDGE COUNT.
;SWINDO PDL 0 ;PREVIOUS SWINDO.
;NFACE,,PFACE 1 ;SUROUNDER FACE LIST,,PENETRATOR FACE LIST.
; NED,,PED 2 ;LAST EDGE BEAD,,FIRST EDGE BEAD.
XLO←←3 ↔ XHI←← 4 ;WINDOW'S BOUNDARIES
YLO←←5 ↔ YHI←← 6 ;IN FLOATING FORMAT.
; VCNT,,CCW 7 ;VERTEX LIST THRU CCW LINKS.
CUTFLG ←← 8 ;0 IN X, -1 IN Y.
;BEAD FORMAT, BEADS LINK EDGES & WINDOWS FOR THE SAKE OF 2-D SORTING.
LEFT (WNBL,0) ;WINDOW'S BEAD LIST.
RIGHT(EDBL,0) ;EDGE'S BEAD LIST.
LEFT (WBEAD,1) ;WINDOW OF A BEAD.
RIGHT(EBEAD,1) ;EDGE OF A BEAD.
;ALTERNATE PDP-10 MNEMONICS.
OPDEF ZIP[HRRZS] ;ZERO INSTRUCTION PART.
OPDEF ZAP[HLLZS] ;ZERO ADDRESS PART.
OPDEF DZM[SETZM] ;DEPOSITE ZERO INTO MEMORY.
;DIAGNOSTICS & CONTROL FLAGS.
ELIMIT: =16 ;EDGES PER WINDOW THRESHOLD. "OCCULT-5"
WNDCNT: 0 ;NUMBER OF XY-SORT WINDOWS. "OCCULT-4"
COMCNT: 0 ;NUMBER OF EDGE-EDGE COMPARES. "OCCULT-3"
DMODE↑: 0 ;DIAGNOSTIC MODE. "OCCULT-2"
SUBR(OCCULT,WRLD) ;A HIDDEN LINE ELIMINATOR.
COMMENT .---------------------------------------------------------------------.
;INITIALIZATION.
LAC 1,WRLD↔DAC 1,WORLD
PFACE 2,1 ;FIRST POTEN FACE.
PED 1,1↔SKIPN 1↔POP1J ;FIRST POTEN EDGE.
SETZM TJLIST ;TJOINT LIST ← NIL.
SETZM COMCNT ;EDGE-EDGE COMPARES COUNT.
SETZM WNDCNT ;SORT-WINDOW COUNT.
CALL(MKSWN,2,1) ;MAKE OUTERMOST SORT-WINDOW FACE,EDGE.
CALL(VSOLVE) ;APPLY VSOLVE TO ALL THE VERTICES.
;SPLIT DIFFICULT SORT-WINDOWS UNTIL THEY ARE SIMPLE.
L1: JFCL;CALL(SWNDPY) ;PATCH IN DIAGONOSTIC.
LAC 1,SWINDO
CDR EDGCNT(1) ;NUMBER OF EDGES IN SORT-WINDOW.
CAMG ELIMIT↔GO L2
CALL(PSHSWN)↔GO L1
;APPLY HIDE TO SIMPLE ENOUGH SORT WINDOW.
L2: CALL(SWNDPY)
CALL(HIDE) ;MARK HIDDEN EDGES & VERTICES.
CALL(POPSWN)
SKIPE SWINDO↔GO L1 ;UNTIL NO MORE SORT-WINDOWS.
SETZB 1↔UPGIOT 15, ;CLEAR SORT-WINDOW GLASS.
SETZB 1↔UPGIOT 14, ;CLEAR SORT-WINDOW GLASS.
SETZB 1↔UPGIOT 13, ;CLEAR SORT-WINDOW GLASS.
SETZB 1↔UPGIOT 12, ;CLEAR SORT-WINDOW GLASS.
CALL(DPYALL)
CALL(SHOW) ;MARK VISIBLE EDGES & VERTICES.
CALL(KLAB) ;RETURNS ATOMS AND BEADS TO FREE STORAGE.
;CLEAR DIAGONOSTIC GLASS & EXIT.
SKIPN DMODE↔POP1J ;EXIT.
SETZB 1↔UPGIOT 16,
POP1J
ENDR OCCULT;BGB 25 FEBRUARY 1973 ----------------------------------------------
SUBR(KLAB) ;KILL ATOMS AND BEADS.
COMMENT .---------------------------------------------------------------------.
DZM ALIST↔DZM BLIST
SKIPE 1,GLIST↔GO[
CDR(1)↔DAC GLIST
CALL(KLNODE↑,1)↔GO .-1]
POP0J
ENDR KLAB;---------------------------------------------------------------------
SUBN(HIDE) ;HIDE A SORT-WINDOW.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{B,E}
;(SUROUNDER-VERTEX COMPARES).
CALL(VERIFY)
;EDGE-EDGE COMPARES.
LAC 1,SWINDO ;CURRENT SORTING WINDOW.
PED B,1↔DAC B,WNBL1 ;FIRST EDGE BEAD OF WINDOW.
L1: SKIPN B,WNBL1↔POP0J ;EXIT END OF LIST.
WNBL 0,B↔DAC WNBL1↔DAC WNBL2 ;NEXT BEAD.
EBEAD E,B↔DAC E,EDG1 ;EDGE OF THIS BEAD.
TEST E,POTENT↔GO L1 ;IGNORE IMPOTENT EDGES.
L2: SKIPN B,WNBL2↔GO L1
WNBL 0,B↔DAC WNBL2 ;NEXT BEAD.
EBEAD E,B↔DAC E,EDG2 ;EDGE OF THIS BEAD.
TEST E,POTENT↔GO L2 ;IGNORE IMPOTENT EDGES.
;WHEN TWO EDGES CROSS MAKE A TJOINT.
CALL(COMPEE,EDG1,EDG2) ;COMPARE THE EDGES.
CAIE 1,441↔GO L2 ;NO INTERSECTION.
CALL(MKTJ,EDG1,EDG2)↔GO L2 ;CROSSING: MAKE TJOINT.
DECLARE{WNBL1,WNBL2,EDG1,EDG2} ;EDGES & BEADS OF THE WINDOW.
ENDR HIDE;BGB 29 APRIL 1974 ---------------------------------------------------
SUBN(MKTJ,FOLD0,EDGE0) ;MAKE A T-JOINT.
COMMENT .---------------------------------------------------------------------.
LAC FOLD0↔DAC FOLD ; ⊗
LAC EDGE0↔DAC EDGE ; |
SETQ(JOT,{EBREAK,FOLD}) ; |
SETQ(JUT,{EBREAK,EDGE}) ; FACE2 FOLD FACE1
; |
;DISTINGUISH ZPP-OVER ≥ ZPP-UNDER. ; EDGE ⊗JOT EJUT
LAC 1,JUT↔LAC 2,JOT ; ⊗-------------⊗-|------------⊗
TJOIN. 1,2↔TJOIN. 2,1 ; V JUT|
LAC ZPP(1)↔CAMGE ZPP(2)↔GO L1 ; |
CAME ZPP(2)↔GO L0 ; ⊗
PED 3,1↔PFACE 4,3↔LAC CC(4)↔NFACE 4,3↔FAD CC(4)↔DAC 5
PED 3,2↔PFACE 4,3↔LAC CC(4)↔NFACE 4,3↔FAD CC(4)↔CAML 5↔GO L1
L0: EXCH 1,2↔DAC 1,JUT↔DAC 2,JOT
LAC EDGE↔EXCH FOLD↔DAC EDGE
L1: MARK 1,JUTBIT↔MARK 2,JOTBIT
;ORIENT EDGES WITH RESPECT TO FOLD FACES.
LAC 1,FOLD
PFACE 0,1↔DAC FACE1↔NFACE 0,1↔DAC FACE2
MOVSI(POTENT)↔AND@FACE1↔AND@FACE2↔ANDCAM@JUT
SETQ(V,{OTHER,EDGE,JUT})
LAC 1,JUT↔PED 1,1↔DAC 1,EJUT
CALL(QFEV,FACE1,FOLD,V)
JUMPG 1,[LAC EDGE↔EXCH EJUT↔DAC EDGE↔GO .+1]
;HIDE UNDER EDGES.
CALL(,FACE1,EJUT,JUT)
CALL(EHIDE,FACE2,EDGE,JUT)
CALL(EHIDE)↔POP2J
DECLARE{EJUT,JOT,JUT,FACE1,FACE2,V,FOLD,EDGE}
ENDR MKTJ;BGB 14 FEBRUARY 1973 ------------------------------------------------
SUBR(MKSWN,FACE,EDGE) ;MAKE FIRST SORT-WINDOW.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{W,B,F,E,V,CNT,VL,EL,FL}
;PLACE ALL POTENTIALLY VISIBLE EDGES & VERTICES INTO THE SORT-WINDOW.
SETZB CNT,EL↔MOVSI VL,1
SETQ(W,{MKNODE↑,{[0]}}) ;MAKE THE OUTERMOST WINDOW.
DAC W,SWINDO↔LAC E,EDGE ;FIRST EDGE OF AN ALT2 LIST.
L1: SETQ(B,{MKBEAD})
WBEAD. W,B↔EBEAD. E,B ;PUT WINDOW & EDGE INTO THE BEAD.
ALT. B,E↔AOS EDGCNT(W) ;PUT BEAD INTO EDGE'S LIST.
SKIPN EL↔NED. B,W ;LAST BEAD.
WNBL. EL,B↔DAC B,EL ;PUT BEAD INTO WINDOW'S LIST.
PVT V,E↔SKIPN 7(V)↔PUSHJ P,[
DAC VL,7(V)↔DAC V,VL↔ ;PUT VERTEX INTO WINDOW LIST.
AOS CNT↔POPJ P,]
NVT V,E↔SKIPN 7(V)↔PUSHJ P,@.-3
ALT2 E,E↔JUMPN E,L1 ;NEXT EDGE OF WORLD LIST.
CW. CNT,W↔CCW. VL,W ;WINDOW'S VERTEX LIST.
PED. EL,W ;WINDOW'S EDGE LIST.
;COPY WORLD'S LIST OF POTENTIALLY VISIBLE FACES.
LAC F,FACE↔SETZ FL, ;POTENT FACE LIST.
JUMPN F,[AOS PENCNT(W) ;INCREMENT PEN-FACE COUNT.
SETQ(FL,{CONS,F,FL}) ;PUT FACE IN FACE LIST.
ALT2 F,F↔GO .] ;NEXT POTENT FACE.
PFACE. FL,W ;PEN-FACE LIST OF WINDOW.
;FIND BOUNDARIES OF THE WINDOW.
MOVSI 1B18↔DAC XHI(W)↔DAC YHI(W) ;EXTREME MAX.
SETCM↔DAC XLO(W)↔DAC YLO(W) ;EXTREME MIN.
SKIPA V,VL
L2: CCW V,V↔JUMPE V,POP2J. ;EXIT.
LAC XPP(V)↔CAMGE XLO(W)↔DAC XLO(W)
LAC XPP(V)↔CAMLE XHI(W)↔DAC XHI(W)
LAC YPP(V)↔CAMGE YLO(W)↔DAC YLO(W)
LAC YPP(V)↔CAMLE YHI(W)↔DAC YHI(W)↔GO L2
ENDR MKSWN;BGB 29 APRIL 1974 --------------------------------------------------
SUBN(CONS,A,B) ;MAKE A 1-WORD ATOM.
COMMENT .---------------------------------------------------------------------.
L1: SKIPN 1,ALIST↔GO L2↔CDR(1)↔DAC ALIST ;LOP A WORD OFF THE ALIST.
LAC B↔HRL A↔DAC(1)↔POP2J
L2: SETQ(GLIST,{MKNODE↑,GLIST})↔MOVEI -3(1) ;GET ANOTHER GEM NODE.
PUSH↔PUSH↔AOS↔PUSH↔SOS 1(1) ;MAKE FREE STORAGE LIST LINKS.
PUSH↔PUSH↔PUSH↔PUSH↔PUSH↔PUSH↔PUSH
DAP ALIST↔GO L1
ENDR CONS;BGB 27 APRIL 1974 ---------------------------------------------------
SUBN(MKBEAD) ;MAKE A 2-WORD BEAD.
COMMENT .---------------------------------------------------------------------.
L1: SKIPN 1,BLIST↔GO L2↔CDR(1)↔DAC BLIST ;LOP A WORD OFF THE BEAD LIST.
DZM(1)↔DZM 1(1)↔POP0J ;RETURN A CLEAN BEAD.
L2: SETQ(GLIST,{MKNODE↑,GLIST}) ;GET GEM NODE.
LAC ALIST↔DAC -1(1) ;PUT ODD WORD INTO THE ALIST.
MOVEI -1(1)↔DAC ALIST ;PUT FIVE BEADS INTO BLIST.
MOVEI -3(1)↔DAC 1(1)
MOVEI 1(1)↔DAC 3(1)↔MOVEI 3(1)↔DAC 5(1)
MOVEI 5(1)↔DAC 7(1)↔MOVEI 7(1)↔DAC BLIST↔GO L1
ENDR MKBEAD;BGB 28 APRIL 1974 -------------------------------------------------
SUBR(POPSWN) ;SORT WINDOW KILL.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{W,B,V}
LAC W,@SWINDO↔EXCH W,SWINDO ;POP SWINDO LIST.
;ZERO WINDOW FIELD OF THE BEADS (AS A MARK FOR BEAD KILLING).
PED B,W↔JUMPE B,.+4 ;BEAD OF THE WINDOW'S ELIST.
ZIP 1(B) ;ZERO WINDOW POINTER OF THIS BEAD.
WNBL B,B↔JUMPN B,.-2 ;NEXT BEAD OF THE WINDOW'S ELIST.
;PUT THE FACE LIST POINTERS OF THE DYING WINDOW INTO ITS VERTICES.
SKIPE DMODE↔GO L2↔DAC W,V
SKIPA 1,1(W)↔DAC 1,1(V) ;XWD SUR,,PEN
CCW V,V↔JUMPN V,.-2
CALL(KLNODE,W)↔POP0J ;KILL THE WINDOW NODE.
;DIAGONOSTIC DISPLAY IS DEPENDENT ON XDC,,YDC OF VERTICES.
L2: SKIPA 1,1(W)↔DAC 1,8(W) ;XWD SUR,,PEN
CCW W,W↔JUMPN W,.-2
CALL(KLNODE,W)↔POP0J ;KILL THE WINDOW NODE.
ENDR POPSWN;BGB 28 APRIL 1974 -------------------------------------------------
SUBR(PSHSWN) ;SORT WINDOW SPLIT FOR 2-D F.E.V. SORTING.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{MID,V,W1,W2,CFLG,PTR1,PTR2,CNT1,CNT2}
ACCUMULATORS{MID,V,W1,W2,CFLG,E,B,B1,B2,X1,Y1,X2,Y2} ;FULL.
SETQ(W2,{MKNODE,SWINDO}) ;MAKE NEW SORT WINDOW.
LAC W1,SWINDO↔DAC W2,SWINDO ;PUSH NEW SORT WINDOW.
HRLZI -3(W1)↔HRRI -3(W2)↔BLT 8(W2) ;COPY CONTENTS OF OLD.
DAC W1,0(W2) ;POINTER TO OLD.
;NEW BOUNDARIES OF THE WINDOW.
SKIPN CFLG,CUTFLG(W1)↔GO[
LAC XLO(W1)↔FAD XHI(W1)↔FSC -1↔DAC MID ;CUTFLG=0 CUT IN X.
DAC XHI(W1)↔DAC XLO(W2)↔GO .+2]↔GO[
LAC YLO(W1)↔FAD YHI(W1)↔FSC -1↔DAC MID ;CUTFLG≠0 CUT IN Y.
DAC YHI(W1)↔DAC YLO(W2)↔GO .+1]
SETCMM CUTFLG(W1)↔SETCMM CUTFLG(W2) ;FLIP CUT FLAGS.
;PARTITION THE VERTICES INTO THE TWO WINDOWS.
HRREI XPP↔SUB CFLG↔DAP AM0 ;ADDR MOD XPP OR YPP.
SETZB CNT1,CNT2↔SETZB PTR1,PTR2
LAC V,W1↔CCW 1,V ;FIRST VERTEX.
L1: LAC V,1↔CCW 1,V↔JUMPE V,L2 ;SAVE NEXT VERTEX.
TEST V,POTENT↔GO L1
AM0: CAMLE MID,00(V)↔GO[
CCW. PTR1,V↔LAC PTR1,V↔AOJA CNT1,L1] ;LOWER OR LEFT WINDOW.
CCW. PTR2,V↔LAC PTR2,V↔AOJA CNT2,L1 ;UPPER OR RIGHT WINDOW.
L2: CW. CNT1,W1↔CCW. PTR1,W1 ;STORE RESULTS.
CW. CNT2,W2↔CCW. PTR2,W2
;(DON'T) REMOVE DEAD BEADS FROM THE WINDOW'S BEAD LIST. (DEAD BEADS CARRY PENS).
; SETZ B1,↔PED B2,W1↔GO .+3 ;FIRST BEAD OF THE WINDOW.
; LAC B1,B2↔WDBL B2,B2 ;ADVANCE DOWN WINDOW'S LIST.
; JUMPN B2,[EBEAD E,B2↔TEST E,POTENT↔GO .-2 ;JUMP EDGE EXISTS.
; LAC B,B2↔EDBL B2,B2 ;BEAD AFTER THE DEAD BEAD.
; SKIPN B1↔PED. B2,W ;NEW HEAD OF LIST.
; SKIPE B1↔WDBL. B2,B1 ;UPDATE PREVIOUS BEAD.
; EXCH B,BLIST↔DAC B,@BLIST ;BURY THE BEAD.
; JUMPN B2,.-2↔GO .+1] ;TEST FOR END.
;EDGE SORT.
;-------------------------------------------------------------------------------
;PARTITION THE EDGES INTO ONE WINDOW OR THE OTHER OR BOTH.
PED B,W1 ;FIRST BEAD OF THE EDGE LIST.
SETZB EDGCNT(W1)↔DZM 2(W1) ;NED,,PED ← 0
SETZB EDGCNT(W2)↔DZM 2(W2)
L3: JUMPE B,[CALL(PENSUR,W1) ;TEST FOR END OF THE EDGE LIST.
CALL(PENSUR,SWINDO)↔POP0J] ;MAKE NEW PEN & SUR FACE LISTS.
EBEAD E,B ;EDGE OF THE BEAD.
NVT 1,E↔LAC X1,XPP(1)↔LAC Y1,YPP(1)
PVT 1,E↔LAC X2,XPP(1)↔LAC Y2,YPP(1)
JUMPN CFLG,L4 ;TEST CUT FLAG.
;X-SPLIT.
CAMLE X1,X2↔GO[ ;FORCE X1,Y1 TO LEFT.
EXCH X1,X2↔EXCH Y1,Y2↔GO .+1]
CAML X1,MID↔GO ONLY2 ;EDGE ONLY IN WINDOW-2.
CAMGE X2,MID↔GO ONLY1 ;EDGE ONLY IN WINDOW-1.
MOVN AA(E)↔FMP MID↔FSB CC(E)↔FDV BB(E) ;Y AT MID = (-AA*MID-CC)/BB.
CAMLE YHI(W1)↔GO[ ;GO MID ABOVE WINDOW.
CAMLE Y1,YHI(W1)↔GO ONLY2↔GO ONLY1]
CAMGE YLO(W1)↔GO[ ;GO MID BELOW WINDOW.
CAMGE Y1,YLO(W1)↔GO ONLY2↔GO ONLY1]
GO BOTH ;MID WITHIN WINDOW.
;Y-SPLIT.
L4: CAMLE Y1,Y2↔GO[ ;FORCE X1,Y1 TO BELOW.
EXCH X1,X2↔EXCH Y1,Y2↔GO .+1]
CAML Y1,MID↔GO ONLY2 ;EDGE ONLY IN WINDOW-2.
CAMGE Y2,MID↔GO ONLY1 ;EDGE ONLY IN WINDOW-1.
MOVN BB(E)↔FMP MID↔FSB CC(E)↔FDV AA(E) ;X AT MID = (-BB*MID-CC)/AA.
CAMLE XHI(W1)↔GO[ ;GO MID ABOVE WINDOW.
CAMLE X1,XHI(W1)↔GO ONLY2↔GO ONLY1]
CAMGE XLO(W1)↔GO[ ;GO MID BELOW WINDOW.
CAMGE X1,XLO(W1)↔GO ONLY2↔GO ONLY1]
GO BOTH ;MID WITHIN WINDOW.
;PLACE THE EDGE BEAD IN THE APPROPRIATE WINDOW.
ONLY1: LAC B1,B↔WNBL B,B↔PUSH P,[L3]
WB1: SKIPN 1,2(W1)↔NED. B1,W1 ;LAST EDGE.
WNBL. 1,B1↔WBEAD. W1,B1 ;WINDOW-LIST & WINDOW.
PED. B1,W1↔AOS EDGCNT(W1)↔POPJ P, ;PUT E-BEAD IN WINDOW.
ONLY2: LAC B2,B↔WNBL B,B↔PUSH P,[L3]
WB2: SKIPN 1,2(W2)↔NED. B2,W2 ;LAST EDGE.
WNBL. 1,B2↔WBEAD. W2,B2 ;WINDOW-LIST & WINDOW.
PED. B2,W2↔AOS EDGCNT(W2)↔POPJ P, ;PUT E-BEAD IN WINDOW.
;THE WINDOW BEADS OF AN EDGE ARE ORDERED LEFT TO RIGHT.
BOTH: SETQ(B2,{MKBEAD}) ;MAKE NEW BEAD.
LAC B1,B↔WNBL B,B ;NEXT BEAD.
JUMPE CFLG,.+3↔CAMLE X1,X2↔EXCH W1,W2 ;SWAP WINDOWS.
WBEAD. W2,B2↔EBEAD. E,B2 ;WINDOW,,EDGE OF B2.
EDBL 1,B1↔EDBL. 1,B2↔EDBL. B2,B1 ;INSERT B2 INTO EDGE.
CALL(WB1)↔CALL(WB2)
JUMPE CFLG,.+3↔CAMLE X1,X2↔EXCH W1,W2 ;SWAP WINDOWS BACK.
GO L3
ENDR PSHSWN;BGB 28 APRIL 1974 --------------------------------------------------
SUBN(PENSUR,WND) ;MAKE PEN & SUR FACE LISTS.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{W,B,F,E,PTR,CNT,X,Y,BIT,Q}
;SCAN THE EDGE-BEADS OF THE WINDOW.
HRLZI BIT,1B18 ;PEN FACE MARKING BIT.
DZM CNT↔DZM PTR ;INIT PEN-COUNTER & PEN-LIST.
LAC W,WND↔PED B,W ;WINDOW & ITS FIRST BEAD.
L1: JUMPE B,L2 ;TEST FOR END OF BEADS.
EBEAD E,B↔WNBL B,B ;EDGE OF BEAD. NEXT BEAD.
PFACE F,E↔CALL(S1) ;APPLY PEN-FACE TWICE.
NFACE F,E↔CALL(S1)↔GO L1
;....................................................................
;PUT FACE IN PEN-LIST.
S1: TEST F,POTENT↔POPJ P, ;POTENT FACE.
SKIPGE(F)↔POPJ P, ;NOT YET IN THIS WINDOW.
IORM BIT,(F) ;MARK THE FACE.
SETQ(PTR,{CONS,F,PTR}) ;PLACE IN PEN FACE LIST.
AOS CNT↔POPJ P,
;....................................................................
;CULL NEW SURROUNDERS FROM THE OLD PENETRATOR LIST.
L2: LAC X,XLO(W)↔FAD X,XHI(W)↔FSC X,-1 ;LOCUS OF MID WINDOW.
LAC Y,YLO(W)↔FAD Y,YHI(W)↔FSC Y,-1
PFACE B,W ;OLD PEN-FACE LIST.
L3: JUMPE B,L4↔CAR F,(B) ;AN OLD PEN FACE.
DAC B,Q↔CDR B,(B) ;NEXT FACE ATOM.
SKIPL(F)↔GO .+3 ;TEST FOR ¬PEN FACE.
ANDCAM BIT,(F)↔GO L3 ;MARKZ PEN FACE.
CALL(WITH2D,F,X,Y)↔GO L3 ;TEST FOR SURROUNDER.
NFACE 0,W↔CALL(CONS,F,0) ;FOUND A SURROUNDER.
NFACE. 1,W↔AOS SURCNT(W)↔GO L3
;....................................................................
L4: PFACE B,W ;OLD PEN-FACE LIST.
DAC CNT,PENCNT(W)↔PFACE. PTR,W ;UPDATE PEN-FACE LIST.
CAME W,SWINDO↔POP1J
EXCH B,ALIST↔DAP B,(Q)↔POP1J ;KILL OLD FACE LIST.
ENDR PENSUR;BGB 28 APRIL 1974 ---------------------------------------
SUBN(VSOLVE) ;SOLVE CONCAVE VERTICES.
COMMENT .--------------------------------------------------------------------.
;Inspect folded concave vertices for easy EHIDE's and easy underfaces.
ACCUMULATORS{F,U,V,E,E0,S0,S1,S2,CNT}
LAC V,SWINDO ;SORT-WINDOW.
VLOOP: CCW V,V↔JUMPE V,POP0J. ;NEXT VERTEX OR EXIT.
HRROS 7(V)↔DAC V,VERTEX# ;UNDEFINED UNDERFACE.
HRREI CNT,-4↔PED 1,V↔DAC 1,E0 ;FOUR OR MORE POTENT EDGES.
ELOOP: TESTZ 1,POTENT↔AOJGE CNT,L0 ;TEST POTENT AND COUNT.
CALL(ECCW,1,V) ;NEXT EDGE.
CAME 1,E0↔GO ELOOP
GO VLOOP
;....................................................................
L0: LAC V,VERTEX
DZM CNT↔TEST V,FOLDED↔GO VLOOP ;OPEN FOLDS COUNT.
PED E,V↔DAC E,E0 ;FIRST EDGE.
L2: TEST E,POTENT↔GO[ ;TEST POTENT.
L1: SETQ(E,{ECCW,E,V}) ;RING'A'ROUND THE VERTEX.
CAME E,E0↔GO L2↔GO VLOOP]
TESTZ ,FOLDED↔AOS CNT ;POTENTIALLY "OPEN" FOLD.
SETQ(U,{OTHER,E,V})
;FOR ALL THE FACES OF THE VERTEX NOT LINKED TO E.
LAC S2,E↔SETQ(S2,{ECCW,S2,V}) ;INITIAL SIDES.
L4: LAC S1,S2↔SETQ(S2,{ECCW,S1,V}) ;ADVANCE SIDES TO NEXT FACE.
CAMN S2,E↔GO L1 ;TEST FOR END OF LOOP.
SETQ(F,{FCCW,S1,V}) ;FACE CCW FROM SIDE-1.
TEST F,POTENT↔GO L4 ;FACE IS POTENTIALLY VISIBLE.
;WHEN QFEV(F,S1,U) > 0
L5: LAC 1,CC(S1)
LAC BB(S1)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S1)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S1↔CAME 0,F↔MOVNS 1
JUMPLE 1,L4
;AND WHEN QFEV(F,S2,U) > 0
LAC 1,CC(S2)
LAC BB(S2)↔FMPR YPP(U)↔FADR 1,0
LAC AA(S2)↔FMPR XPP(U)↔FADR 1,0
PFACE 0,S2↔CAME 0,F↔MOVNS 1
JUMPLE 1,L4
;TRY TO HIDE THE EDGE UNDER THE FACE.
L6: TESTZ E,FOLDED↔SOS CNT ;DECREMENT CNT FOR CLOSED FOLDS.
CALL(ZDEPTH,F,U)
JUMPN[CALL(EHIDE,F,E,V)↔GO L0] ;EARLY EDGE HIDE.
TEST E,FOLDED↔GO L4
UFACE 0,E↔JUMPLE 0,L7
DAC F,7(P)↔DAC 1,6(P)↔DAC 0,F ;SAVE F AND ITS ZDEPTH AT U.
CALL(ZDEPTH,F,U) ;GET ZDEPTH OF E'S PREVIOUS UNDERFACE.
CAMGE 1,6(P)↔EXCH F,7(P) ;SKIP IF PREVIOUS UFACE COVERS PRESENT.
L7: UFACE. F,E↔GO L4 ;FOUND A NEW UNDERFACE FOR E.
ENDR VSOLVE;BGB 31 JULY 1973 --------------------------------------------------
SUBN(EHIDE,FACE,EDGE,VERTEX) ;EDGE HIDE.
COMMENT .---------------------------------------------------------------------.
;If EHIDE has already been invoked then PUSH arguments into a BEAD.
;This is so the regular control PDL (AC-17) isn't over PUSHed.
SKIPE HIDING↔GO[CALL(MKBEAD)↔LAC FACE↔DIP 0(1)↔LAC EDGE↔DIP 1(1)
LAC VERTEX↔DAP 1(1)↔EXCH 1,HIDLST↔DAP 1,@HIDLST↔POP3J]↔SETOM HIDING
;INITIALIZATION.
L0: SKIPN 1,EDGE↔GO L9↔TEST 1,POTENT↔GO L9
LAC 2,FACE↔TEST 2,POTENT↔GO L9
ALT. 1,2↔PED 0,2↔DAC E0↔DAC E
LAC VERTEX↔DAC V1↔SETQ(V2,{OTHER,EDGE,V1})
CALL(VERIFY)
;QMASK←(IF V2=NVT(E) THEN 200 ELSE 100).
MOVEI 200↔LAC 1,EDGE↔NVT 1,1
CAME 1,V2↔MOVEI 100↔DAC QMASK
;COMPARE EDGE WITH FACE.
L1: CALL(COMPEE,EDGE,E)↔JUMPLE 1,L2 ;DISJOINT.
TDNE 1,QMASK↔GO[LAC 1,EDGE↔MARKZ 1,POTENT
CALL(DPYALL)
GO L9] ;V2 TOUCHING E.
TRNN 1,1↔GO L2 ;CROSSING.
;CROSSING - CONTINUE INTO NEXT FACE OR MAKE A TJOINT.
L4: ;(CHECK ZDEPTH AT CROSSING).
CALL(OTHER,E,FACE)
TEST 1,POTENT↔GO L5
ALT 0,1↔CAMN 0,EDGE↔GO L9 ;DON'T VISIT SAME FACE TWICE.
LAC 0,EDGE↔ALT. 0,1
DAC 1,FACE↔LAC E↔DAC E0
;DISJOINT - CONTINUE ON THIS FACE OR HIDE EDGE.
L2: SETQ(E,{ECCW,E,FACE})
CAME 1,E0↔GO L1
;(CHECK DEPTH OF V2 WITH RESPECT TO FACE).
LAC 1,EDGE↔MARKZ 1,POTENT
CALL(DPYALL)
CALL(VHIDE,FACE,V2)↔GO L9
;MAKE A TJOINT.
L5: LAC 1,EDGE↔MARKZ 1,POTENT↔LAC 2,V2↔PED. 1,2
CALL(EBREAK,EDGE)↔MARK 1,JUTBIT↔PUSH P,1 ;JOINT UNDER T.
CALL(EBREAK,E)↔MARK 1,JOTBIT↔POP P,2 ;JOINT OVER T.
TJOIN. 1,2↔TJOIN. 2,1
LAC 1,V2↔PED 1,1↔MARK 1,POTENT
CALL(DPYALL)
;POP EHIDE EDGE LIST OR EXIT.
L9: SKIPN 1,HIDLST↔GO[SETZM HIDING↔POP3J] ;EXIT.
CDR 0,0(1)↔DAC HIDLST↔CAR 0,0(1)↔DAC FACE
CDR 0,1(1)↔DAC VERTEX↔CAR 0,1(1)↔DAC EDGE
EXCH 1,BLIST↔DAC 1,@BLIST↔GO L0 ;BURY THE BEAD.
DECLARE{E0,E,V1,V2,QMASK,HIDLST}
ENDR EHIDE; BGB 14 FEBRUARY 1974 ----------------------------------------------
HIDING: 0
SUBN(VHIDE,FACE,VERTEX) ;VERTEX HIDE.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{F,V,E,E0,ECNT}
LAC V,VERTEX↔TEST V,POTENT↔POP2J ;EXIT IF VERTEX IS HIDDEN.
CALL(WITHIN,FACE,VERTEX)↔GO L6
CALL(ZDEPTH,FACE,VERTEX)↔JUMPE[L6:
WARNING(VHIDE VERTEX ESCAPED.)↔CALL(VERIFY)↔POP2J]
;SEE IF WE CAN HIDE THE JOT OF A JUT.
LAC V,VERTEX↔SETZ ECNT,
TEST V,JUTBIT↔GO L1↔TJOINT V,V ;GET JOT.
CALL(ZDEPTH,FACE,V)↔JUMPE L1 ;NO - JOT IS OVER FACE.
DAC V,VERTEX ;YES - JOT IS UNDER FACE.
CALL(VERIFY)
;HIDE THE VERTEX AND ALL ITS POTENT EDGES.
L1: LAC V,VERTEX↔MARKZ V,POTENT ;HIDE THE VERTEX.
CDR F,FACE↔UFACE. F,V ;FACE HIDES THIS VERTEX.
PED E,V↔DAC E,E0
L2: TESTZ E,POTENT↔GO[SOS HIDING ;FORCE EHIDE INTO BEAD PUSHING.
CALL(EHIDE,FACE,E,V)↔AOJA ECNT,.+1]
SETQ(E,{ECCW,E,V})↔CAME E,E0↔GO L2 ;CIRCLE VERTEX PERIMETER.
;HIDE THE JUT OF A JOT.
LAC V,VERTEX↔TEST V,JOTBIT↔GO L3
TJOINT V,V↔DAC V,VERTEX ;GET JUT.
TESTZ V,POTENT↔GO L1
;EXIT - WAKING UP EHIDE IF THERE'S WORK TO DO THAT IT DOESN'T KNOW ABOUT.
L3: ADDM ECNT,HIDING ;RESTORES THE HIDING SWITCH.
SKIPE ECNT↔SKIPE HIDING↔POP2J ;DON'T RUN EHIDE.
CALL(EHIDE,[0],[0],[0])↔POP2J ;RUN EHIDE.
ENDR VHIDE; BGB 14 FEBRUARY 1974 ----------------------------------------------
SUBN(COMPEE,EDG1,EDG2) ;COMPARE EDGE-EDGE.
COMMENT ⊗----------------------------------------------------------------------
-1 EDGES ARE DISJOINT.
0 EDGES E1 AND E2 ARE IDENTICAL.
+441 EDGE CROSS EACH OTHER.
+110 PVT(E1) IS JOINED TO PVT(E2).
+120 PVT(E1) IS JOINED TO NVT(E2).
+210 NVT(E1) IS JOINED TO PVT(E2).
+220 NVT(E1) IS JOINED TO NVT(E2).
------------------------------------------------------------------------------⊗
ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2}
DEFINE EPSLON<[0.000001]>
AOS COMCNT
SETZ 1,↔LAC E1,EDG1↔LAC E2,EDG2
CAMN E1,E2↔POP2J ;IDENTITY CASE.
;FETCH ENDPOINTS - TEST TJOINTS TO GET THE JOT.
PVT V1,E1↔NVT V2,E1
PVT U1,E2↔NVT U2,E2
MOVSI(JUTBIT)
TDNE(V1)↔TJOINT V1,V1
TDNE(V2)↔TJOINT V2,V2
TDNE(U1)↔TJOINT U1,U1
TDNE(U2)↔TJOINT U2,U2
;TEST FOR EDGES ALREADY HAVING A VERTEX OR TJOINT IN COMMON.
HRREI 1,110↔CAMN V1,U1↔POP2J
HRREI 1,120↔CAMN V1,U2↔POP2J
HRREI 1,210↔CAMN V2,U1↔POP2J
HRREI 1,220↔CAMN V2,U2↔POP2J
;THE SPAN OVERLAPPING TEST PREVENTS NASTY PARALLEL (& COLINEAR) CASES.
;TEST FOR X-SPAN NOT OVERLAPPING.
LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
;TEST FOR Y-SPAN NOT OVERLAPPING.
LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[
L0: SETO 1,↔POP2J] ;EXIT EDGES ARE DISJOINT.
;COMPARE E1 AND U1.
L1: SETZ 1,↔LAC Q1,CC(E1)
LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
MOVM Q1↔CAMG EPSLON↔TRO 1,10
;COMPARE E1 AND U2.
LAC Q2,CC(E1)
LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
MOVM Q2↔CAMG EPSLON↔TRO 1,20
;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
TRO 1,40 ;E1 CROSSES E2'S LINE.
;COMPARE E2 AND V1.
LAC Q1,CC(E2)
LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
MOVM Q1↔CAMG EPSLON↔TRO 1,100
;COMPARE E2 AND V2.
LAC Q2,CC(E2)
LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
MOVM Q2↔CAMG EPSLON↔TRO 1,200
;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
TRO 1,400 ;E2 CROSSES E1'S LINE.
;ELIMINATE COINCIDANT EDGE-VERTEX OCCURENCES BY FUDGING.
TRNE 1,010↔GO[CALL(FUDGE,U1,E1)↔GO L1] ;U1 NEAR E1'S LINE.
TRNE 1,020↔GO[CALL(FUDGE,U2,E1)↔GO L1] ;U2 NEAR E1'S LINE.
TRNE 1,100↔GO[CALL(FUDGE,V1,E2)↔GO L1] ;V1 NEAR E2'S LINE.
TRNE 1,200↔GO[CALL(FUDGE,V2,E2)↔GO L1] ;V2 NEAR E2'S LINE.
;SOLVE FOR CROSSING LOCUS.
L2: DAC 1,AC1#
LAC AA(E1)↔FMPR BB(E2)
LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
LAC BB(E1)↔FMPR CC(E2)
LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
LAC CC(E1)↔FMPR AA(E2)
LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
LAC XCROSS↔FMPR[3.5]↔DAC XCRUX
LAC YCROSS↔FMPR[3.5]↔DAC YCRUX
LAC 1,AC1↔TRO 1,1↔POP2J
ENDR COMPEE; BGB 1 MARCH 1973 -------------------------------------------------
DECLARE{XCROSS,YCROSS,ZCROSS,XCRUX,YCRUX}
SUBN(FUDGE,VERTEX,EDGE)
COMMENT .---------------------------------------------------------------------.
;Move 2-D vertex locus away from the edge alittle.
ACCUMULATORS{V,E}↔SAVAC(11)
CALL(VERIFY)
LAC V,VERTEX↔LAC E,EDGE
LAC BB(E)↔FSC -5↔FADRM YPP(V)
LAC AA(E)↔FSC -5↔FADRM XPP(V)
PED E,V↔DAC E,E0↔DAC E,E1
L: CALL(ECOEF↑,E1)
SETQ(E1,{ECCW,E1,VERTEX})
CAME 1,E0↔GO L
GETAC(11)↔POP2J
DECLARE{E0,E1}
ENDR FUDGE; BGB 1 MARCH 1973 --------------------------------------------------
SUBN(ZDEDGE,EDGE);SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
COMMENT .---------------------------------------------------------------------.
;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
ACCUMULATORS{E,V1,V2}
LAC E,EDGE
PVT V1,E↔NVT V2,E
MOVM 0,AA(E)↔MOVM 1,BB(E)↔CAMGE 1,0↔GO L
;WHEN DX ≥ DY:
LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
;WHEN DY > DX:
L: LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
ENDR ZDEDGE; BGB 10 FEBRUARY 1974 ---------------------------------------------
SUBN(EBREAK,EDGE) ;EBREAK(EDGE) IS LIKE ESPLIT.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{B,E,V,Q,R,ENEW,VNEW,PV,NV}
CALL(ZDEDGE,EDGE) ;COMPUTE ZDEPTH AT CROSSING.
CDR E,EDGE↔PVT V,E↔CCW B,E
;MAKE NEW VERTEX.
SETQ(VNEW,{MKV↑,B})
HLLZ(E)↔TLZ 777677; ¬FOLDED ;E FOLDED IMPLIES VNEW FOLDED.
TLO(TMPBIT+POTENT)↔IORM(VNEW) ;VNEW'S TYPE BITS.
CAR 1,TJLIST
JUMPE 1,[DAP VNEW,TJLIST↔GO .+2] ;PUT VNEW AT FRONT OF TJLIST.
TJ. VNEW,1↔DIP VNEW,TJLIST ;PUT VNEW AT END OF TJ LIST.
MOVSI XCROSS↔HRRI XPP(VNEW)↔BLT ZPP(VNEW)
SKIPE DMODE↔GO[
LAC XCRUX↔XDC. 0,VNEW
LAC YCRUX↔YDC. 0,VNEW↔GO .+1]
LAC ZCROSS↔DAC ZPP(VNEW)
;MAKE NEW EDGE.
SETQ(ENEW,{MKE↑,B})
MOVSI AA(E)↔HRRI AA(ENEW)↔BLT 1(ENEW) ;COPY COEFFICIENTS, TYPE & FACES.
LAC 8(E)↔DAC 8(ENEW) ;COPY USER WORD.
UFACE 0,E↔UFACE. 0,ENEW ;COPY UNDERFACE.
LAC 1,WORLD↔NED 2,1↔NED. ENEW,1 ;PUT EDGE IN POTENT EDGE LIST.
ALT2. ENEW,2
;PLACE VNEW BETWEEN E AND ENEW.
PED 0,V↔CAMN E↔PED. ENEW,V
PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,ENEW
PVT. VNEW,E↔NVT. VNEW,ENEW
PCW 0,E↔CALL(WING↑,0,ENEW)↔NCCW 0,E↔CALL(WING,0,ENEW)
NCCW. ENEW,E↔PCW. ENEW,E↔NCW. E,ENEW↔PCCW. E,ENEW
;SPLIT BEAD'S LIST OF THE EDGE.
CALL(BLED,VNEW)↔LAC VNEW,1(P) ;RESTORE VNEW.
PED ENEW,VNEW↔PFACE 2,ENEW
TESTZ 2,POTENT↔GO .+3
CALL(INVERT↑,ENEW) ;FORCE PFACE TO BE POTENT.
LAC 1,VNEW↔POP1J ;RETURN'S VNEW.
ENDR EBREAK; BGB 10 FEBRUARY 1973 ---------------------------------------------
SUBR(BLED,VNEW) ;BEAD LIST EDIT.
COMMENT .--------------------------------------------------------------------.
ACCUMULATORS{V,E,ENEW,W,B1,B2,B3,X,Y,Q}
LAC V,VNEW↔PED ENEW,V
SETQ(E,{ECCW,ENEW,V}) ;PICKUP ARGUMENTS.
ALT 0,ENEW↔SKIPE↔EXCH E,ENEW ;IDENTIFY THE REAL ENEW.
LAC X,XPP(V)↔LAC Y,YPP(V) ;VERTEX LOCUS.
;REMOVE DEAD BEADS FROM THE EDGE'S BEAD LIST.
SETZ B1,↔ALT B2,E↔GO L1+2 ;FIRST WINDOW BEAD OF EDGE.
L1: LAC B1,B2↔EDBL B2,B2 ;ADVANCE DOWN EDGE'S LIST.
JUMPE B2,L2-3 ;TEST FOR END OF LIST.
WBEAD W,B2↔↔JUMPN W,L1 ;JUMP WINDOW EXISTS.
LAC Q,B2↔EDBL B2,B2 ;BEAD AFTER THE DEAD BEAD.
SKIPN B1↔ALT. B2,E ;DEAD BEAD WAS FIRST.
SKIPE B1↔EDBL. B2,B1 ;DEAD BEAD WAS N'TH.
EXCH Q,BLIST↔DAC Q,@BLIST ;RETURN BEAD TO BLIST.
JUMPN B2,L1 ;TEST FOR END.
;DOES VNEW BELONG IN THIS WINDOW.
SETZ B1,↔ALT B2,E↔GO L2+2 ;FIRST BEAD OF E.
L2: LAC B1,B2↔EDBL B2,B2 ;NEXT BEAD.
JUMPE B2,L5↔WBEAD W,B2 ;WINDOW OF THE BEAD.
CAML X,XLO(W)↔CAML X,XHI(W)↔GO L2
CAML Y,YLO(W)↔CAML Y,YHI(W)↔GO L2
MOVSI 1↔ADDM 7(W) ;INCREMENT VCNT (KEPT IN CW).
CCW Q,W↔CCW. Q,V↔CCW. V,W ;PUT VERTEX INTO THE WINDOW.
;MAKE NEW BEAD FOR THIS WINDOW.
L3: SETQ(B3,{MKBEAD})↔ALT. B3,ENEW ;PUT ENEW IN BEAD B3.
WBEAD. W,B3↔EBEAD. ENEW,B3 ;WINDOW & EDGE OF THE BEAD.
AOS EDGCNT(W) ;INCREMENT EDGE COUNTER.
NED Q,W↔WNBL. B3,Q↔NED. B3,W ;PUT BEAD AT END OF WINDOW.
EDBL Q,B2
;IF ENEW IS LEFT OF E THEN CASE2.
CALL(OTHER,ENEW,V)
CAML X,XPP(1)↔GO CASE2
;E ON LEFT, ENEW ON RIGHT. BEAD LIST ORDER: E(B1,B2,NIL) LIST AT B2.
CASE1: ZAP(B2)↔EDBL. Q,B3 ;END OF BEAD LIST AT B2.
L4: EBEAD. ENEW,B3↔EDBL B3,B3 ;PLACE ENEW INTO ITS BEADS.
JUMPN B3,L4
L5: LAC 1,VNEW↔POP1J ;RETURN'S VNEW.
;ENEW ON LEFT, E ON RIGHT. BEAD LIST ORDER: ENEW(B1,B3,NIL) E(B2,Q,...)
CASE2: ALT 0,E↔ALT. B2,E ;FIRST BEAD OF E.
JUMPE B1,.+3
ALT. 0,ENEW↔EDBL. B3,B1 ;FIRST BEAD OF ENEW AND LAST BEAD.
ALT B3,ENEW↔GO L4
ENDR BLED;BGB 29 APRIL 1974 ---------------------------------------------------
SUBN(SHOW) ;PROPAGATE VISIBLE EDGES AND VERTICES.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{J}
;ESTABLISH JUT VISIBILITY AND FIND JUT UNDERFACES.
CDR J,TJLIST↔SKIPA ;FIRST TJOINT.
L1: TJ J,J↔JUMPE J,L2-2 ;TEST END OF LIST.
SETCM(J)↔TLNE(JUTBIT+POTENT)↔GO L1 ;SKIP JUTBIT∧POTENT ARE ON.
CALL(FSCAN,J)↔JFCL ;SKIP JUT IS VISIBLE.
LAC J,1(P)↔UFACE. 1,J↔GO L1 ;PUT UNDERFACE IN JUT & CONTINUE.
;APPLY TJPROP TO ALL THE POTENT JUTS.
CDR J,TJLIST↔SKIPA
L2: TJ J,J↔JUMPE J,L3-2
SETCM(J)↔TLNE(JUTBIT+POTENT)↔GO L2 ;SKIP JUTBIT∧POTENT ARE ON.
CALL(TJPROP,J)
LAC J,1(P)↔GO L2
;APPLY VSHOW TO ALL THE POTENT JOTS AND JUTS.
CDR J,TJLIST↔SKIPA
L3: TJ J,J↔JUMPE J,L4
TEST J,POTENT↔GO L3
CALL(VSHOW,J,J)
POP P,J↔GO L3
;SCAN WORLD'S POTENT EDGE LIST FOR ANY REMAINING POTENT EDGES.
L4: LAC 1,WORLD↔PED 1,1↔GO L5+1
LAC 1,ELIST# ;RESTORE.
L5: ALT2 1,1↔JUMPE 1,L6-2 ;SCAN FOR POTENT EDGES.
TEST 1,POTENT↔GO L5
DAC 1,ELIST# ;SAVE.
PVT 1,1↔DAC 1,VERTEX# ;TRY TO MAKE POTENT E VISIBLE.
CALL(FSCAN,VERTEX)↔GO L5-1 ;SKIP VISIBLE VERTEX.
CALL(EPROP,1,[0],VERTEX) ;PROPAGATE UNDERFACE OF VERTEX.
CALL(VSHOW,VERTEX)↔GO L5-1 ;MARK VERTICES & EDGES AS VISIBLE.
;ELIMINATE JOT'S LACKING VISIBLE JUTS.
CDR J,TJLIST↔SKIPA
L6: TJ J,J↔JUMPE J,L7
TEST J,JOTBIT↔GO L6 ;TEST FOR JOT.
TJOINT 1,J ;GET ITS JUT.
TESTZ 1,VISIBLE↔GO L6 ;TEST FOR INVISIBLE JUT.
TJ 1,J↔CALL(KLEV↑,1,J) ;KILL JOT.
POP P,J↔GO L6+1
;MAKE VISIBLE EDGE LIST.
ACCUMULATORS{W,E,EL}
L7: MOVSI(VISIBLE)↔LAC W,WORLD
PED E,W↔TDCA EL,EL
L8: ALT2 E,E
JUMPE E,[PED. EL,W↔POP0J] ;ACTUALLY VISIBLE EDGE LIST.
TDNN 0,(E)↔GO L8 ;TEST FOR VISIBLE EDGE.
ALT2 1,E↔ALT2. EL,E
LAC EL,E↔LAC E,1↔GO L8+1 ;PUT E IN LIST.
ENDR SHOW;7/25/73(BGB)-----------------------------------------------
SUBN(VSHOW,VERTEX) ;MARK VISIBLE EDGES & VERTICES.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{V,E,E0,F}
DZM VLST# ;VERTEX SHOW PDL LIST.
LAC V,VERTEX↔TEST V,POTENT↔POP1J
LAC(V)↔TLC(POTENT+VISIBLE)↔DAC(V) ;TOGGLE INTO VISIBLITY.
;CHECK UNDERFACE OF THE VERTEX.
L1: ;CALL(VERIFY)
TESTZ V,FOLDED↔GO[
UFACE 1,V↔JUMPGE 1,.+1 ;UFACE EXISTS - SO CONTINUE.
CALL(FSCAN,V)↔GO L3 ;FIND UNDERFACE AND SKIP.
CALL(EPROP,1,[0],VERTEX)↔GO .+1] ;PROPAGATE UNDERFACE.
;PUSH NEIGHBORING POTENT VERTICES INTO THE VLST.
LAC V,VERTEX↔PED E,V↔DAC E,E0 ;INITIALIZE VERTEX GO ROUND.
L2: TESTZ E,POTENT↔GO[
LAC(E)↔TLC(POTENT+VISIBLE)↔DAC(E) ;TOGGLE E'S POTENT+VISIBLE.
CALL(OTHER,E,V)
TEST 1,POTENT↔GO .+1
TLC(POTENT+VISIBLE)↔DAC(1) ;SERVES TO MARK AS ON VLIST.
LAC VLST↔CCW. 0,1↔DAC 1,VLST↔GO .+1] ;PUSH VERTEX INTO LIST.
SETQ(E,{ECCW,E,V})
CAME E,E0↔GO L2
;ADVANCE TO NEXT VERTEX ON THE VLIST.
L3: SKIPN V,VLST↔POP1J ;POP VERTEX FROM LIST.
DAC V,VERTEX↔CCW 1,V↔DAC 1,VLST↔GO L1
ENDR VSHOW;BGB 26 JUNE 1973 ---------------------------------------------------
SUBN(TJPROP,J) ;PROPAGATE UNDERFACES FROM TJOINTS.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{UF1,UF2,JUT,JOT,F1,F2,E,E1,E2,V1}
; CALL(VERIFY)
;PICKUP ALL THE FRIENDS OF THE PRESENT JUT. ; ⊗V1
LAC JUT,J↔TJOINT JOT,JUT↔PED E1,JOT ; |
SETQ(E2,{ECCW,E1,JOT}) ; F1 UF1 |E1
SETQ(V1,{OTHER,E1,JOT}) ; |
PED E,JUT↔TESTZ E,POTENT↔GO L1 ; EDGE JUT ⊗JOT
SETQ(E,{ECCW,E,JUT})↔PED. E,JUT ; ⊗-----------⊗-|------------⊗
L1: PFACE F1,E↔TEST F1,POTENT↔UFACE F1,JUT ; |
NFACE F2,E↔TEST F2,POTENT↔UFACE F2,JUT ; F2 UF2 |E2
; |
;FORCE ORIENTATION AS IN THE MANDALA. ; ⊗
LAC 1,CC(E)
LAC BB(E)↔FMPR YPP(V1)↔FADR 1,0
LAC AA(E)↔FMPR XPP(V1)↔FADR 1,0
SKIPG 1↔EXCH E1,E2↔PED. E1,JOT
;PROPAGATE UNDERFACES OF THIS JOT.
CALL(,F2,E,JUT)
CALL(,F2,E2,JOT)
CALL(EPROP,F1,E1,JOT) ;EDGE UNDERFACE PROPAGATION.
CALL(EPROP)
CALL(EPROP)
POP1J
ENDR TJPROP; BGB 4 MARCH 1974 -------------------------------------------------
SUBN(EPROP,UF,EDGE,VERTEX) ;PROPAGATE UNDER FACE ALONG FOLDS.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{A2,A3,E,V,F,JUT,EJ,JOT}
;PUT UNDERFACE INTO VERTEX.
L0: LAC V,VERTEX↔TEST V,FOLDED↔POP3J ;EXCLUD ¬FOLDED VERTICES.
SKIPGE F,UF↔POP3J↔UFACE. F,V ;PUT UFACE INTO THE VERTEX.
SKIPN E,EDGE↔GO[PED E,V↔GO L2]
SETCM(E)↔TLNE(FOLDED+POTENT)↔POP3J
;PUT UNDERFACE INTO EDGE.
L1: UFACE 1,E↔CAMN 1,UF↔POP3J ;UNDER FACES ARE CONSISTENT.
LAC F,UF↔UFACE. F,E ;PUT UNDERFACE INTO EDGE.
CALL(VERIFY)
SETQ(VERTEX,{OTHER,E,V})↔DAC 1,V ;GET NEXT VERTEX OF CURVE.
TESTZ V,JUTBIT↔POP3J ;STOP AT JUTS.
TESTZ V,JOTBIT↔GO[
TJOINT 1,V↔TESTZ 1,POTENT↔POP3J ;REAL TJOINT JOT.
GO .+1] ;JOT WITH HIDDEN JUT.
JUMPE F,L2
CALL(LINKED↑,F,V)↔JUMPN 1,POP3J. ;EXIT UFACE LINKED TO VERTEX.
;FOLLOW CURVE OF FOLDED EDGES.
L2: UFACE. F,V↔DAC E,1 ;PUT UNDERFACE INTO VERTEX.
L3: CALL(ECCW,1,V)↔CAMN 1,E↔POP3J ;EXIT: E' NOT FOUND.
SETCM(1)↔TLNE(FOLDED+POTENT)↔GO L3 ;E' MUST BE FOLDED & POTENT.
UFACE A3,1↔DAC 1,A2
JUMPG A3,[CALL(LINKED,A3,V) ;IS E' UFACE LINKED TO V ?
JUMPE 1,.+1↔LAC 1,A2↔GO L3] ;YES-FALL THRU. NO-LOOP BACK.
LAC E,A2↔DAC E,EDGE↔GO L1 ;E' UFACE NOT CONNECTED TO V.
ENDR EPROP; BGB 4 MARCH 1973 --------------------------------------------------
SUBN(FSCAN,VERTEX) ;FACE SCAN FOR UNDERFACE.
COMMENT .---------------------------------------------------------------------.
ACCUMULATORS{F,V,E,E0,PEN,SUR}
LAC BGND↔DAC FMAX
MOVSI 1B18↔DAC ZMAX
;FOR ALL THE FACES ON THE LISTS OF THE WINDOW CONTAINING THIS VERTEX.
LAC V,VERTEX
SKIPE DMODE↔GO[NUF SUR,V↔PUF PEN,V↔GO L1]
NFACE SUR,V ;SUR-FACE LIST ATOM.
PFACE PEN,V ;PEN-FACE LIST ATOM.
L1: SKIPE SUR↔GO[CAR F,(SUR)↔CDR SUR,(SUR)↔GO L3]
SKIPE PEN↔GO[CAR F,(PEN)↔CDR PEN,(PEN)↔GO L2]
AOS(P)↔LAC 1,FMAX↔POP1J ;UNDERFACE FOUND SKIP EXIT.
L2: CALL(WITHIN,F,V)↔GO L1
L3: CALL(ZDEPTH,F,V)↔JUMPN L4 ;JUMP VERTEX HIDDEN BY F.
CAMGE 1,ZMAX↔GO L1
DAC F,FMAX↔DAC 1,ZMAX ;SAVE NEW UNDERFACE CANDIDATE.
GO L1
;VERTEX HIDDEN BY A FACE - NO SKIP EXIT.
L4: MARK V,POTENT
MARKZ V,VISIBLE
CALL(VHIDE,F,V)
POP1J
DECLARE{FMAX,ZMAX}
ENDR FSCAN; BGB 24 JUNE 1973 --------------------------------------------------
SUBR(SWNDPY)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{W,B,E}
SKIPN DMODE↔POP0J
JFCL
CALL(DPYSET↑,DPYBUF↑)
CALL(DPYBRT,[5])
CALL(WINDPY,SWINDO) ;CURRENT WINDOW.
LAC W,SWINDO↔PED B,W
L1: JUMPE B,L2↔EBEAD E,B↔WNBL B,B ;EDGES OF SWINDO.
CALL(EDGDPY,B,E)↔POP P,B↔GO L1
CALL(DPYBRT,[2])
CALL(AIVECT,[0],[0])
L2: CALL(DPYOUT,[15])
CALL(DPYSET,DPYBUF) ;DISPLAY WINDOW & EDGES.
LAC W,SWINDO
L3: CALL(WINDPY,W,W)↔POP P,W
SKIPE W,(W)↔GO L3
CALL(DPYOUT,[14])
CALL(DPYSET,DPYBUF) ;DISPLAY WINDOW LIST.
POP0J
ENDR SWNDPY;---------------------------------------------------------
SUBR(WINDPY,WIND)
COMMENT .-----------------------------------------------------------.
LAC 1,WIND
LAC XLO(1)↔FMPR[3.5]↔FIXX↔DAC XL#
LAC XHI(1)↔FMPR[3.5]↔FIXX↔DAC XH#
LAC YLO(1)↔FMPR[3.5]↔FIXX↔DAC YL#
LAC YHI(1)↔FMPR[3.5]↔FIXX↔DAC YH#
CALL(AIVECT↑,XL,YL)
CALL(AVECT↑,XH,YL)↔CALL(AVECT,XH,YH)
CALL(AVECT,XL,YH)↔CALL(AVECT,XL,YL)
LAC XL↔ADD XH↔ASH -1↔PUSH P,
LAC YL↔ADD YH↔ASH -1↔PUSH P,↔CALL(AIVECT)
POP1J
ENDR WINDPY;---------------------------------------------------------
SUBR(EDGDPY,EDGE)
COMMENT .-----------------------------------------------------------.
LAC 2,EDGE
PVT 1,2↔LAC XPP(1)↔FMPR[3.5]↔FIXX↔DAC XL
LAC YPP(1)↔FMPR[3.5]↔FIXX↔DAC YL
NVT 1,2↔LAC XPP(1)↔FMPR[3.5]↔FIXX↔DAC XH
LAC YPP(1)↔FMPR[3.5]↔FIXX↔DAC YH
CALL(AIVECT,XL,YL)↔CALL(AVECT,XH,YH)↔POP1J
DECLARE{XL,YL,XH,YH}
ENDR EDGDPY;---------------------------------------------------------
SUBR(QQQDPY,EDGE)
COMMENT .-----------------------------------------------------------.
DZM WNUMB#
CALL(DPYSET↑,DPYBUF↑)
CALL(EDGDPY,EDGE)
LAC 1,EDGE↔ALT 1,1
L1: JUMPE 1,L2
WBEAD 0,1↔EDBL 1,1↔JUMPE 0,L1↔PUSH P,1
CALL(WINDPY,0)↔CALL(OCTDPY↑,WNUMB)↔AOS WNUMB
POP P,1↔GO L1
L2: CALL(DPYOUT,[15])
POP1J
ENDR QQQDPY;---------------------------------------------------------
SUBR(KLJOTS,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V}
CDR B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JOTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJOTS;2/16/73(BGB)---------------------------------------------
SUBR(KLJUTS,WORLD)
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
;FOR ALL THE VERTICES OF EACH BODY.
LAC V,B
L2: NVT V,V
TEST V,VBIT↔GO L1
TEST V,TMPBIT↔GO L2
TEST V,JUTBIT↔GO L2
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L2+1
ENDR KLJUTS;2/16/73(BGB)---------------------------------------------
SUBR(KLTMPS,WORLD) ; KILL ALL THE TMP VERTICES IN THE WORLD.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{B,V,E}
LAC B,WORLD
L1: CCW B,B↔CAMN B,WORLD↔POP1J
LAC E,B
L2: NED E,E↔CAMN E,B↔GO L3-1
TEST E,TMPBIT↔GO L2
NED E,E↔PUSH P,E↔PUSH P,B
PED E,E↔CALL(KLFE,E)
POP P,B↔POP P,E↔GO L2+1
LAC V,B
L3: NVT V,V↔CAMN V,B↔GO L1
TEST V,TMPBIT↔GO L3
NVT V,V↔PUSH P,V↔PUSH P,B
PVT V,V↔CALL(KLEV,V)
POP P,B↔POP P,V↔GO L3+1
ENDR KLTMPS;3/16/73(BGB)------------------------------------------
SUBR(VERIFY) ;DIAGONOSTIC DISPLAY.
COMMENT .-----------------------------------------------------------.
SKIPN DMODE↔POP0J
SAVAC(16)
CDR 1,-1(P) ;POINTER TO HIS RETURN ADDRESS.
CDR 1,-1(1) ;POINTER TO HIS ENTRY ADDRESS.
CDR 0,-1(1) ;POINTER TO HIS SIXBIT NAME.
CAR 1,-1(1)↔ANDI 1,7↔DAC 1,ARGCNT ;NUMBER OF ARGUMENTS.
LAC 2,[POINT 7,NAME]↔LAC 1,@0 ;SIXBIT TO ASCIZ.
SKIPE 1↔GO[
SETZ↔ROTC 0,6↔ADDI 0,40
IDPB 0,2↔GO .-1]↔IDPB 1,2
CALL(DPYSET,DPYBUF)↔AOS STEP
CALL(DPYBRT,[2])
CALL(AIVECT,[-=510],[-=220])↔CALL(DPYBIG,[4])
CALL(DECDPY,STEP)↔CALL(DPYSTR,{[[ASCIZ/. /]]})
CALL(DPYSTR,[NAME])
;GET POINTER TO HIS ARGUMENTS.
MOVEI 16,-1(17) ;STACK POINTER TO HIS RETURN ADR.
LAC ARGCNT↔SUB 16,0
MOVNS↔DIP 0,16 ;AOBJN POINTER.
DAC 16,SAV#
JUMPE 0,L3 ;HE'S GOT NO ARGUMENTS.
;DISPLAY ARGUMENT LIST.
PUSH P,["("]↔SKIPA
L0: CALL(DTYO,{[","]})↔CDR 1,(16)
CAMLE 1,44↔GO .+3
CALL(IDPY↑,1)
AOBJN 16,L0
CALL(DTYO,{[")"]})
LAC 16,SAV
L1: HRRE 1,(16)↔JUMPLE 1,L2 ;GET AN ARGUMENT.
LAC 0,(1) ;GET ITS TYPE BITS.
TLNE(FBIT)↔GO[CALL(FDPY,1)↔GO L2]
TLNE(EBIT)↔GO[CALL(QDPY↑,1)↔GO L2]
TLNE(VBIT)↔GO[CALL(QDPY↑,1)↔GO L2]
L2: AOBJN 16,L1
L3: CALL(DPYBIG,[2])↔CALL(DPYOUT,[16])
SETZ↔SKIPE RUNFLG↔GO L4
;NOT RUNNING - SINGLE STEP VERIFICATION.
INCHRW
CAIN 175↔SETOM RUNFLG
CAIL"0"↔CAILE"9"↔GO L9
ANDI 17↔LAC 1,STEP2
IMULI 1,=10↔ADD 1↔DAC STEP2
GO L3
;RUNNING UNTIL STEP2 OR CHR.
L4: SKIPE 1,STEP2↔CAMLE 1,STEP↔GO .+4
SETZM STEP2↔SETZM RUNFLG↔GO L3
INCHRS↔GO L9↔SETZM RUNFLG↔GO L3
L9: GETAC(16)↔POP0J
NAME:0↔0
ARGCNT:0
DECLARE{RUNFLG,STEP,STEP2}
ENDR;2/24/73------------------------------------------------------
EXTERN DPYSET,DPYBUF,DPYOUT,DPYBRT,DPYBIG,BUFDPY
EXTERN AIVECT,AVECT,FLODPY,DECDPY,DPYSTR,DTYO
FDPY:
BEGIN FDPY
LAC 1,-1(P)↔DAC 1,F
PED 1,1↔DAC 1,E0↔DAC 1,E
CALL(DPYBRT,[3])
CALL(VCW,E,F)↔ XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AIVECT,0,1)
L: CALL(VCCW,E,F)↔ XDC 0,1↔FIXX↔YDC 1,1↔FIXX 1,↔CALL(AVECT,0,1)
SETQ(E,{ECCW,E,F})↔CAME 1,E0↔GO L
CALL(DPYBRT,[2])↔POP1J
DECLARE{F,E,E0}
BEND;2/10/73------------------------------------------------------
SUBR(DPYALL)
COMMENT .-----------------------------------------------------------.
SKIPN DMODE↔POP0J
CALL(DPYSET↑,DPYBUF)
LAC 1,UNIVERSE↑
SON 1,1↔DAC 1,WORLD#↔DAC 1,B#
L1: LAC 1,B↔CCW 1,1↔DAC 1,B
CAMN 1,WORLD↔GO[CALL(DPYOUT,[1])↔POP0J]
SKIPA
L2: LAC 1,E↔PED 1,1↔DAC 1,E#
CAMN 1,B↔GO L1
TEST 1,POTENT↔GO L2
PVT 2,1↔NVT 3,1
XDC 0,3↔FIXX↔PUSH P,↔YDC 0,3↔FIXX↔PUSH P,
XDC 0,2↔FIXX↔PUSH P,↔YDC 0,2↔FIXX↔PUSH P,
CALL(AIVECT↑)↔CALL(AVECT↑)↔GO L2
ENDR DPYALL;------------------------------------------------------
SUBR(SHADOW,WRLD)
COMMENT .-----------------------------------------------------------.
POP1J
ENDR SHADOW;3/11/74(BGB)---------------------------------------------
;DEFINE CRE LINK NAMES.
%←←1B18
DEFINE LEFT $(NAM,WRD){
DEFINE NAM(A,Q)<CAR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DIP A,%+WRD(Q)>}
DEFINE RIGHT $(NAM,WRD){
DEFINE NAM(A,Q)<CDR A,%+WRD(Q)>
DEFINE NAM$.(A,Q)<DAP A,%+WRD(Q)>}
LEFT(%CW, 0)↔RIGHT(%CCW,0) ;RING LINKS.
LEFT(%DAD,1)↔RIGHT(%SON,1) ;TREE OF RINGS.
LEFT(%TYP,2)↔RIGHT(%ALT,2)
LEFT(%ROW,3)↔RIGHT(%COL,3) ;IMAGE LOCUS.
OPDEF FLO[FSC 225] ;FLOAT INTEGER 0000.00
LEFT(%ENDO,3)↔RIGHT(%EXO,3) ;NESTED POLYGON TREE.
LEFT(%ARC,4)
LEFT(%NGON,5)↔RIGHT(%PGON,5) ;NESTED POLYGON TREE.
LEFT(%NTIM,6)↔RIGHT(%PTIM,6) ;TIME LINE LINKS.
;FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
COMMENT /
The Next Visible Edge Conjecture - the next visible edge CW
(or CCW) about a vertex in 3D (from the external side of a
polyhedron) must be the next visible edge CW (or CCW) about that
vertex in any 2D image in which the retex is visible./
SUBR(QCW,EDGE,VERTEX)
COMMENT .-----------------------------------------------------------.
U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: PVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: NVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCW;8/4/73(BGB)-------------------------------------------------
SUBR(QCCW,EDGE,VERTEX)
COMMENT .-----------------------------------------------------------.
U←←16 ↔ V←←15 ↔ E←←14
LAC V,VERTEX↔LAC 1,EDGE
TESTZ V,JUTBIT↔GO L1
TESTZ V,JOTBIT↔GO L2
L0: CALL(ECCW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J ;¬TJ.
L1: NVT U,1↔TJOINT V,V↔PED 1,V ;JUT.
CAME U,VERTEX↔POP2J
CALL(ECCW,1,V)↔POP2J
L2: PVT U,1↔CAME U,V↔GO L3 ;JOT.
CALL(ECCW,1,V)↔POP2J
L3: TJOINT 1,V↔PED 1,1↔POP2J
ENDR QCCW;8/4/73(BGB)------------------------------------------------
SUBR(CREIMG) ;CRE IMAGE: MAKE PERCIEVED IMAGES FROM CRE.
COMMENT .-----------------------------------------------------------.
EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E}
SKIPN A,%+1↔POP0J
DAC A,%IMG↔DAC A,%IMG0 ;FIRST CRE IMAGE OF FILM.
;GET CONTEXT OF THESE IMAGES.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
SETOM ICNT#
;MAKE A GEOMED IMAGE.
L4: SETQ(IMG,{MKNODE,[$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
AOS A,ICNT↔DAC A,-1(1) ;CRE IMAGE NUMBER.
;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
PIMAG A,C↔JUMPN A,L4A ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L5B
L4A: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L5B: PIMAG. 1,C
LAC A,%IMG↔%SON A,A
DAC A,%LEV↔DAC A,%LEV0 ;FIRST LEVEL OF IMAGE.
L3: LAC A,%LEV↔%SON A,A
DAC A,%PGN↔DAC A,%PGN0 ;FIRST POLYGON OF LEVEL.
L2: LAC A,%PGN↔%SON A,A
DAC A,%V↔DAC A,%V0 ;FIRST VERTEX OF POLYGON.
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER POLYGON.
SETQ(FACE,{MKF,BDY})
SETQ(V0,{MKV,BDY})↔DAC 1,V
;COPY THE CRE-VECTORS INTO GEOMED EDGES & VERTICES.
L1: LAC 2,%V
%ROW 0,2↔FLO↔FSB[108.0]
MOVNM YPP(1)↔FMPR[0.04]↔MOVNM YWC(1)
%COL 0,2↔FLO↔FSB[144.0]
DAC XPP(1)↔FMPR[0.04]↔DAC XWC(1)
MOVSI(<131072.0>)↔MOVNM ZPP(1) ;ZDEPTH PERSPECTIVE 2↑17.
%CCW 2,2↔DAC 2,%V ;NEXT VECTOR.
CAME 2,%V0↔GO[
SETQ(V,{MKEV,FACE,V})↔PED E,1
MARK E,POTENT↔GO L1] ;NEXT EDGE.
CALL(MKFE,V0,FACE,V)↔MARK 1,POTENT ;LAST EDGE.
;CLOSE LOOPS.
LAC 1,%PGN↔%CCW 1,1↔DAC 1,%PGN ;NEXT POLYGON.
CAME 1,%PGN0↔GO L2
LAC 1,%LEV↔%CCW 1,1↔DAC 1,%LEV ;NEXT LEVEL.
CAME 1,%LEV0↔GO L3
LAC 1,%IMG↔%CCW 1,1↔DAC 1,%IMG ;NEXT IMAGE.
CAME 1,%IMG0↔GO L4
LAC 1,IMG↔POP0J
DECLARE{CAMERA,WORLD}
DECLARE{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
ENDR CREIMG;3/14/73(BGB)------------------------------------------
SUBR(OCCIMG) ;MAKE OCCULT IMAGE FROM OCCULT RESULTS.
COMMENT .---------------------------------------------------------------------.
EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
ACCUMULATORS{A,B,C,D,E,F,Q,V,U}
;GET CONTEXT OF THIS IMAGE.
LAC 1,UNIVERSE
NWRLD 1,1↔DAC 1,WORLD ;"NOW" WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;"NOW" CAMERA.
;MAKE A GEOMED IMAGE NODE.
SETQ(IMG,{MKNODE,[$IMAGE]})
CW. 1,1↔CCW. 1,1 ;EMPTY BODY RING.
LAC WORLD↔PWRLD. 0,1 ;WORLD OF THIS IMAGE.
LAC C,CAMERA↔NCAMR. C,1 ;CAMERA OF THIS IMAGE.
;PLACE THE IMAGE INTO THE CAMERA'S PREDICTED IMAGE RING.
SIMAG A,C↔JUMPN A,L1 ;JUMP WHEN ¬NEW RING.
PTIME. 1,1↔NTIME. 1,1↔GO L2
L1: PTIME B,A
PTIME. 1,A↔NTIME. A,1
PTIME. B,1↔NTIME. 1,B
L2: SIMAG. 1,C
SETQ(BDY,{MKB,IMG}) ;ONE BODY PER IMAGE.
SETQ(BGND,{MKF,BDY}) ;BACK GROUND FACE.
LAC E,WORLD↔PED E,E
SKIPA
;COPY ALL THE VISIBLE EDGES.
L3: ALT2 E,E↔JUMPE E,L6
SETQ(Q,{MKE↑,BDY})
ALT. E,Q↔ALT. Q,E
CAR(E)↔ANDI(DARKEN+NSHARP+FOLDED+VISIBLE+EBIT)↔DIP(Q)
;COPY THE FACES OF EACH EDGE.
NFACE F,E↔TESTZ E,FOLDED↔UFACE F,E ;FACE OR UNDER FACE.
JUMPE F,.+2
TEST F,POTENT↔GO[LAC U,BGND↔GO L3N] ;BACKGROUND FACE.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3N] ;ALT FACE EXISTS.
MARK F,TBIT1
SETQ(U,{MKF,BDY}) ;MAKE F'S ALT FACE.
LAC 1,1(U)
MOVSI AA(F)↔HRRI AA(U)↔BLT 8(U)
DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3N: NFACE. U,Q
PFACE F,E
TEST F,POTENT↔GO[LAC U,BGND↔GO L3P] ;BACKGROUND FACE.
TESTZ F,TBIT1↔GO[ALT U,F↔GO L3P] ;ALT FACE EXISTS.
MARK F,TBIT1
SETQ(U,{MKF,BDY}) ;MAKE F'S ALT FACE.
LAC 1,1(U)
MOVSI AA(F)↔HRRI AA(U)↔BLT 8(U)
DAC 1,1(U)
ALT. F,U↔ALT. U,F↔PED. Q,U
L3P: PFACE. U,Q
;COPY THE VERTICES OF EACH EDGE.
NVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4N]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U) ;PP LOCUS.
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4N: NVT. U,Q
PVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
TESTZ V,TBIT1↔GO[ALT U,V↔GO L4P]
MARK V,TBIT1
SETQ(U,{MKV↑,BDY})
ALT. V,U↔ALT. U,V↔PED. Q,U
LAC XPP(V)↔DAC XPP(U)
LAC YPP(V)↔DAC YPP(U)
LAC XWC(V)↔DAC XWC(U) ;WC LOCUS.
LAC YWC(V)↔DAC YWC(U)
LAC ZWC(V)↔DAC ZWC(U)
L4P: PVT. U,Q
GO L3
;FIX UP THE WING LINKS.
L6: LAC E,WORLD↔PED E,E↔SKIPA
L7: ALT2 E,E↔JUMPE E,POP0J.↔ALT Q,E
PVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔PCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔NCCW. 1,Q
NVT V,E
CALL(QCCW,E,V)↔ALT 1,1↔NCW. 1,Q
CALL(QCW,E,V)↔ ALT 1,1↔PCCW. 1,Q
GO L7
DECLARE{CAMERA,WORLD,BDY,IMG,BGND}
ENDR OCCIMG;7/13/73(BGB)------------------------------------------
SUBR(MKCONE,BODY,Z1,Z2)
COMMENT .-----------------------------------------------------------.
;CHECK BODY ARGUMENT.
LAC 1,BODY↔TEST 1,BBIT↔POP3J
SETQ(BNEW,{MKCOPY↑,BODY}) ;COPY LAMINA INTO NOW WORLD.
PFACE 1,1↔DAC 1,FACE ;FIRST FACE.
;GET NOW CAMERA.
LAC 1,UNIVERSE↑↔NWRLD 1,1 ;NOW WORLD.
NCAMR 1,1↔DAC 1,CAMERA ;NOW CAMERA.
;CONVERT Z ARGUMENT FROM ZDEPTH ≡ ABS(ZCC) INTO ZPP.
LAC 1,-1(1)↔LAC 2,1 ;SCALEZ.
FDVR 1,Z1↔FDVR 2,Z2
MOVMM 1,Z1↔MOVMM 2,Z2
CALL(SETZPP,FACE,Z1,CAMERA)
CALL(SWEEP↑,FACE,[0]) ;SWEEP SILHOUETTE CONE.
CALL(SETZPP,FACE,Z2,CAMERA)
LAC 1,BNEW
POP3J
DECLARE{CAMERA,BNEW,FACE}
ENDR MKCONE;9/3/73(BGB)----------------------------------------------
SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
COMMENT .-----------------------------------------------------------.
; Clock around all the vertices of a face setting their ZPP.
LAC 1,FACE↔MARK 1,100
PED 1,1 ;1ST EDGE OF FACE.
DAC 1,EDGE0↔DAC 1,EDGE
L1: SETQ(VERTEX,{VCCW↑,EDGE,FACE})
LAC ZDEPTH↔DAC ZPP(1) ;ZPP OF VERTEX.
CALL(UNPROJECT↑,VERTEX,CAMERA) ;UNPROJECT THE VERTEX.
SETQ(EDGE,{ECCW↑,EDGE,FACE}) ;GET NEXT EDGE.
MARK 1,100
CAME 1,EDGE0↔GO L1 ;TEST FOR 1ST EDGE.
POP3J
DECLARE{EDGE,EDGE0,VERTEX}
ENDR SETZPP;9/3/73(BGB)----------------------------------------------
SUBR(SHINE,WRLD) ;SHINE THE SUN AT ALL THE FACES OF A WORLD.
COMMENT .-----------------------------------------------------------.
ACCUMULATORS{F,B,Q}
LAC B,WRLD
;RAY OF SUN SHINE - MINUS K VECTOR.
ALT Q,B↔ALT2 Q,Q ;SUN FRAME.
HRLZI XWC(Q)↔AOS↔BLT 3
FMP 1,1↔FMP 2,2↔FMP 3,3
LAC 1↔FAD 2 ↔FAD 3↔CALL(SQRT,0)
LAC XWC(Q)↔FDVR 1↔MOVNM AASUN
LAC YWC(Q)↔FDVR 1↔MOVNM BBSUN
LAC ZWC(Q)↔FDVR 1↔MOVNM CCSUN
;BODIES OF THE WORLD.
LAC B,WRLD
L0: CCW B,B↔CAMN B,WRLD↔POP1J
CALL(FACOEF↑,B,B)↔POP P,B↔LAC F,B
L1: PFACE F,F↔CAMN F,B↔GO L0
; TEST F,POTENT↔GO L1
;FETCH THE PHOTOMETRIC PARAMETERS OF THE FACE.
SKIPN 1,4(F)↔SETO 1,↔DAC 1,WORD4
SKIPN 1,5(F)↔LAC 1,[010101010000]↔DAC 1,WORD5
;DOT FACE NORMAL INTO SUN RAY FOR INCIDENT POWER.
LAC 0,AA(F)↔FMPR 0,AASUN
LAC 1,BB(F)↔FMPR 1,BBSUN↔FADR 0,1
LAC 1,CC(F)↔FMPR 1,CCSUN↔FADR 0,1↔FMPR 0,SOLAR
CAMGE[0.002]↔SETZ
;COMPUTED REFLECTED INTENSITIES.
L2: LDB 1,[POINT 9,WORD4,35]↔FSC 1,222↔FMPR 1,0
LDB[POINT 9,WORD4,8]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,8] ;RED.
LDB[POINT 9,WORD4,17]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,17] ;GREEN.
LDB[POINT 9,WORD4,26]↔FSC 222
FMPR 1↔FIXX↔DPB[POINT 9,INTEN,26] ;BLUE.
FIXX 1,↔DPB 1,[POINT 9,INTEN,35] ;WHITE.
LAC INTEN↔DAC QQ(F)↔GO L1
AASUN: 0 ;SUN'S MINUS K UNIT VECTOR IN WORLD COORDINATES.
BBSUN: 0
CCSUN: -1.0
SOLAR: 512.0 ;PSEUDO SOLAR CONSTANT.
WORD4: 0 ;REFLECTIVITIES.
WORD5: 0 ;LUMINOSITIES.
INTEN: 0 ;FINAL INTENSITY BYTES: (RED,GRN,BLU,WHT).
ENDR SHINE;3/14/74(BGB)----------------------------------------------
END